Looping through multiple Sheets in Multiple Workbooks

Question

My Macro needs to run through this range in the worksheet "AtualizaABS" that contains the data necessary for the Macro to work:

The Macro must check Column F in the range to identify the name of sheet in the current workbook where it is going to paste data (Variable "Destino" in the code).
Once it has done that, the Macro proceeds to open a new folder in which it is going to search for the workbook which name matches the value in Column E (Variable "ABSid" in the code).
After identifying the workbook, the Macro must copy all of the cells of the sheet which name matches the values in Column G (Variable "Dados" in the code) and then paste the data from the newly opened workbook into the original one (exactly in the sheet determined by variable "Destino" and column F).

The code works for the first row of the range, but when it comes to looping through the other criteria in the sheet "AtualizaABS" and the other Workbooks to be opened, it fails (even though I used "For each" commands).

How could I make the Macro loop through the rows in my range and then through the workbooks in the folder determined by the code?

Sub CopyThenPaste()

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range
On Error GoTo Errorcatch

'States the number of the last row thtat contains relevant information to the Macro
ultima_linha = Range("e2", Range("e2").End(xlDown)).Rows.Count

'Selects the data to be used in the Macro
Worksheets("AtualizaABS").Activate
For i = 2 To ultima_linha + 1
Destino = ActiveSheet.Cells(i, 6).Value
Dados = ActiveSheet.Cells(i, 7).Value
ABSid = ActiveSheet.Cells(i, 5).Value

'Selects all of the cells of the worksheet that is going to be updated
    Set wb1 = ActiveWorkbook
    For Each Sheet In wb1.Worksheets
    Set PasteStart = Worksheets(Destino).[A1]
    Sheets(Destino).Select
    Cells.Select

'Asks the user what is the folder where VBA should look for the Workbook with the new information
    With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Por favor escolha uma pasta"
    .AllowMultiSelect = False
    If .Show = -1 Then Pasta = .SelectedItems(1)
    End With


'Opens the new workbook, copies and then pastes the data in the current Workbook
    For Each wb2 In Workbooks
    Set wb2 = Workbooks.Open(Filename:=Pasta & "\" & ABSid & ".xls")
    wb2.Sheets(Dados).Select
    Cells.Select
    Selection.Copy
    wb1.Worksheets(Destino).Paste Destination:=PasteStart

    Application.CutCopyMode = False
    wb2.Close


    Next

    Next


Next


Exit Sub
Errorcatch:
MsgBox Err.Description


End Sub

Thanks for the attention.

YowE3K YowE3K · Accepted Answer · 2016-10-19T02:15:59

You don't need to loop through all Workbook objects, or through all Worksheet objects, so your code can be simplified to:

Sub CopyThenPaste()

    Dim wb1 As Workbook
    Set wb1 = ActiveWorkbook

    Dim wsAtualizaABS As Worksheet
    Set wsAtualizaABS = wb1.Worksheets("AtualizaABS")

    Dim wb2 As Workbook

    Dim Destino As String
    Dim Dados As String
    Dim ABSid As String
    Dim Pasta As String

    On Error GoTo Errorcatch

    'States the number of the last row that contains relevant information to the Macro
    ultima_linha = wsAtualizaABS.Range("e2").End(xlDown).Row

    For i = 2 To ultima_linha
        Destino = wsAtualizaABS.Cells(i, 6).Value
        Dados = wsAtualizaABS.Cells(i, 7).Value
        ABSid = wsAtualizaABS.Cells(i, 5).Value

'********************
'**** This block of code can probably be executed outside the loop,
'**** unless the path to each workbook is different
        'Asks the user what is the folder where VBA should look for the Workbook with the new information
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Title = "Por favor escolha uma pasta"
            .AllowMultiSelect = False
            If .Show = -1 Then Pasta = .SelectedItems(1)
        End With
'********************

        'Opens the new workbook, copies and then pastes the data in the current Workbook
        Set wb2 = Workbooks.Open(Filename:=Pasta & "\" & ABSid & ".xls")
        wb2.Sheets(Dados).Cells.Copy Destination:=wb1.Worksheets(Destino).Range("A1")
        wb2.Close

    Next

    Exit Sub

Errorcatch:
    MsgBox Err.Description

End Sub

Looping through multiple Sheets in Multiple Workbooks

1 Answers