Paste filtered data from multiple worksheets into a VBA

0

My goal is to get data from 4 spreadsheets and paste them into one another, and then update multiple spreadsheets with that data.

The code I'm using is as follows: My goal is to get data from 4 spreadsheets and paste them into one another, and then update multiple spreadsheets with that data.

The code I'm using is as follows:

Dim wsOrigem As Worksheet
Dim wsDestino As Worksheet
Dim wb As Workbook
Dim nomeTemplates(3)
Dim nomeMacros(11)
Dim contador
Dim enderecoTemplate
Dim enderecoMacro
Dim linha: linha = 1
Dim index
Dim qtdLinhas
Dim aux: aux = 1

enderecoMacro = "C:\Macros"
enderecoTemplate = "C:\Template"

'Alimentação das Variáveis
nomeTemplates(0) = "Template1.xlsx"
nomeTemplates(1) = "Template2.xlsx"
nomeTemplates(2) = "Template3.xlsx"
nomeTemplates(3) = "Template4.xlsx"

nomeMacros(0) = "Macro1.xlsm"
nomeMacros(1) = "Macro2.xlsm"
nomeMacros(2) = "Macro3.xlsm"
nomeMacros(3) = "Macro4.xlsm"
nomeMacros(4) = "Macro5.xlsm"
nomeMacros(5) = "Macro6.xlsm"
nomeMacros(6) = "Macro7.xlsm"
nomeMacros(7) = "Macro8.xlsm"
nomeMacros(8) = "Macro9.xlsm"
nomeMacros(9) = "Macro10.xlsm"
nomeMacros(10) = "Macro11.xlsm"
nomeMacros(11) = "Macro12.xlsm"

For contador = 0 To 4 Step 1
    Set wb = Workbooks.Open(enderecoTemplate + nomeTemplates(contador))
    Set wsOrigem = wb.Worksheets("Status Report")

  With wsOrigem
    qtdLinhas = Range("D1").End(xlDown).Row + 1
    Range("D1").End(xlUp).Select

        For index = 0 To qtdLinhas Step 1
            If Cells.Interior.Color = 1 Then
             linha = linha + 1
            Else
                wsOrigem.Range(Cells(linha, 4), Cells(linha, 18)).Copy

                Workbooks("Atualização de     Controles").Worksheets("Atualização_de_Controles").Range(Cells(aux, 4),     Cells(aux, 18)).Paste
                aux = aux + 1
                 'ActiveSheet.Paste Destination:=wsDestino.Range(Cells(aux, 4), Cells(aux, 18))

            End If
        Next
    End With

Next

Range(D2, R1048576).Copy

For contador = 0 To 11 Step 1
    Set wsDestino = Workbooks(nomeMacros(contador)).Worksheets("Controle")

    With wsDestino
    Sheets("Controle").Select
    Sheets("Controle").Range("A2:BD1048576").Delete

    ActiveSheet.Paste Destination:=wsDestino.Range("D2:R1048576")
    End With

    Workbooks(nomeMacros(contador)).Close SaveChanges:=True
Next

MsgBox "Importação de Dados Concluída"

Where am I going wrong?

    
asked by anonymous 18.06.2018 / 18:24

0 answers