Filling and importing data with VBA in excel, help in code?

Asked

Viewed 481 times

0

Hello, the situation that I am trying to automate in excel, through VBA is the following: I have two spreadsheets (different excel files), where the two have the same header (with information like ID, Name, Description...), but with columns in different order (in sheet 1, Name is column C, and in sheet 2, Name is column F, for example). In one of these worksheets, the content is filled and in the other there is only the header, so I created a VBA button in the worksheet where there is only the header, so that it looks for the information corresponding to each column of the header and imports the data (copy and paste)automatically. The code I created is the following, and this giving error, referring to object :

Sub Botão4_Clique()

    Dim contador, col As Integer
    Dim valor, PastaAtual, NomeDoArquivo, NomeCompletoDoArquivo As String
    Dim Busca As Range

    contador = 0
    col = 1

    ThisWorkbook.Worksheets("Plan1").Activate


    Do While Cells(1, col).Value <> ""

        Cells(1, col).Select
        valor = Cells(1, col).Value


        PastaAtual = Application.ActiveWorkbook.Path
        NomeDoArquivo = "teste.xlsx"
        NomeCompletoDoArquivo = PastaAtual + "\" + NomeDoArquivo
        Workbooks.Open (NomeCompletoDoArquivo)

        Set Busca = Cells.Find(What:=valor, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate

        ThisWorkbook.Worksheets("Plan1").Activate
        Cells(1, col).Activate
        Set tbl = ActiveCell
        tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
        ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Select
        Selection.Copy
        Workbooks(NomeCompletoDoArquivo).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False


        contador = contador + 1
       col = col + 1
    Loop


MsgBox contador


End Sub

What could be wrong? Thank you

    • Sorry, the button is actually in the spreadsheet where the data is filled.
  • "[...] and is giving error, referring to object". In which line?

  • In the "Find" command, in Set Search = Cells.Find(What:=value, ...

1 answer

1

The Excerpt seems incorrect:

 Set Busca = Cells.Find(What:=valor, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate

In accordance with https://msdn.microsoft.com/en-us/library/office/ff837085.aspx Range.Activate is a method and as such he does not expect to return a value Range for Search but a Variant

In addition there are other mistakes. I propose the following:

Sub Importa()

Dim contador, col As Integer
Dim valor, PastaAtual, NomeDoArquivo, NomeCompletoDoArquivo As String
Dim Busca As Range
Dim RangeFrom As Range
Dim RangeTo As Range
Dim Busca_col As Integer
Dim WorkBookNovo As Workbook

contador = 0
col = 1


ThisWorkbook.Worksheets("Plan1").Activate
PastaAtual = Application.ActiveWorkbook.Path
NomeDoArquivo = "Pasta2.xlsx"
NomeCompletoDoArquivo = PastaAtual + "\" + NomeDoArquivo
Set WorkBookNovo = Workbooks.Open(NomeCompletoDoArquivo)
ThisWorkbook.Worksheets("Plan1").Activate

Do While Cells(1, col).Value <> ""

    Cells(1, col).Select
    valor = Cells(1, col).Value

    Columns(col).Select
    numRows = Selection.Rows.Count
    Selection.Resize(numRows - 1).Select
    Selection.Offset(1, 0).Select
    Set RangeFrom = Selection

    WorkBookNovo.Activate
    Set Busca = WorkBookNovo.Application.Cells.Find(What:=valor, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    Busca.Activate
    Busca_col = Busca.Column
    WorkBookNovo.ActiveSheet.Columns(Busca_col).Select
    numRows = Selection.Rows.Count
    Selection.Resize(numRows - 2).Select
    Selection.Offset(2, 0).Select
    Selection.Value = RangeFrom.Value
    ThisWorkbook.Worksheets("Plan1").Activate

    contador = contador + 1
   col = col + 1
Loop

MsgBox contador

End Sub

If you want to improve the demepenho it would be nice to identify the last line to delimit a smaller range instead of ActiveSheet.Columns(Busca_col).Select

  • Thanks Ruben, it worked this way. However, there are many columns, and it copies only a few, and some it pastes the same column over and over again. I tried to find a possible mistake, but I couldn’t. I forgot to comment that both worksheets have the first empty line, the Dice in the second line and then the data from the third line, this may be the cause of the problem ? I’m learning VBA so I don’t know exactly ! Thank you

  • Yes. This different column header layout will not work. You should make some changes. 1) The line <code>Thisworkbook.Worksheets("Plan1"). Activate</code> at the beginning of <code>Do While</code> must be before the beginning of the block. This will ensure that it traverses the first line of the source spreadsheet. 2) At the time of data collage, the <code>Row</code> parameter of the <code>Selection.Resize</code> and <code>Selection.Offset</code>.

  • I will edit the answer according to this explanation. If it serves you mark as answer :-) .

  • A cool resource for you to learn is using the debugger. Place a red ball by clicking on the side of the code line at the point where you want the code to stop. Give F8 and see the behavior of the code. A second, record macros and study the codes that Excel generated with the debugger. This is how I learned a lot when working with VBA.

Browser other questions tagged

You are not signed in. Login or sign up in order to post.