VBA遍历工作簿+复制和粘贴

Sub TraverseWorkbook()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim destSheet As Worksheet
    Dim lastRow As Long
    
    ' 设置目标工作表
    Set destSheet = ThisWorkbook.Sheets("目标工作表")
    
    ' 遍历所有打开的工作簿
    For Each wb In Workbooks
        ' 排除当前工作簿
        If wb.Name <> ThisWorkbook.Name Then
            ' 遍历当前工作簿中的所有工作表
            For Each ws In wb.Worksheets
                ' 复制当前工作表的数据到目标工作表
                lastRow = destSheet.Cells(destSheet.Rows.Count, 1).End(xlUp).Row
                ws.UsedRange.Copy destSheet.Cells(lastRow + 1, 1)
            Next ws
        End If
    Next wb
    
    ' 清除剪贴板中的内容
    Application.CutCopyMode = False
    
    MsgBox "遍历并复制粘贴完成！"
End Sub