在多个工作簿中循环显示多个工作表

我的macros需要在工作表“AtualizaABS”中运行这个范围，该工作表包含macros工作所需的数据：

1. macros必须检查范围中的列F以标识当前工作簿中要粘贴数据（工作表中的variables“Destino”）的工作表名称。

2. 一旦完成，macros继续打开一个新文件夹，在该文件夹中将search名称与列E（variables“ABSid”中的值）匹配的工作簿。

3. 在识别工作簿之后，macros必须复制名称与列G（variables“Dados”中的值）相匹配的工作表的所有单元格，然后将新打开的工作簿中的数据粘贴到原始工作簿中由variables“Destino”和列F）确定的工作表。

该代码适用于该范围的第一行，但是当涉及到循环显示“AtualizaABS”表中的其他条件以及要打开的其他工作簿时，它将失败（即使我使用了“For each”命令）。

我怎么能通过在我的范围内的行，然后通过由代码确定的文件夹中的工作簿macros循环？

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 

感谢您的关注。

Answer 1

您不需要遍历所有Workbook对象或所有Worksheet对象，因此您的代码可以简化为：

 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