循环使用多个工作簿中的多个表格-Java 学习之路

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

enter image description here

宏必须检查范围中的列F，以标识当前工作簿中要粘贴数据的工作表名称（代码中的变量“Destino”） .
完成后，宏继续打开一个新文件夹，在该文件夹中，它将搜索与E列中的值匹配的工作簿（代码中的变量“ABSid”） .
在识别工作簿之后，宏必须复制工作表的所有单元格，其名称与列G中的值（代码中的变量“Dados”）匹配，然后将新打开的工作簿中的数据粘贴到原始工作簿中（确切地说）在由变量“Destino”和列F）确定的表格中 .

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

我怎样才能使宏循环遍历我的范围内的行，然后通过代码确定的文件夹中的工作簿？

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

感谢您的关注 .

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

回复于 2024-05-17T17:28:35+08:00

循环使用多个工作簿中的多个表格

1 回答

相关问题