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

Question

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

Navigation

#1 by (1 votes)

0

Hello, the situation I am trying to automate in excel, through VBA is as follows: I have two spreadsheets (different excel files), where both have the same heading (with information like ID, Name, Description ... ), but with the columns in different order (in worksheet 1, Name is column C, and in worksheet 2, Name is column F, for example). In one of these spreadsheets, the content is filled in and in the other there is only the header, so I created a VBA button in the spreadsheet where there is only the header so that it looks up 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 it is 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

excel vba

asked by anonymous 02.02.2017 / 04:24

1 answer

Problems selecting Toggle page content by changing div only

score 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

As link Range.Activate is a method and as such it does not expect to return a Range value for Search but a Variant

In addition there are other errors. 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 ranking, it would be legal to identify the last line to delimit a smaller range in place of ActiveSheet.Columns(Busca_col).Select