将多个工作簿合并为一个工作簿

Question

我需要将多个工作簿合并为一个工作簿。

源工作簿具有唯一的工作表名称 = "job"

目标工作簿有多个工作表名称

下面的代码有两个问题，

1. For循环不起作用

2. 目标工作簿中粘贴的数据创建一个新工作表。 但我需要将数据粘贴到现有工作表中。

    Sub combine() 'destination worksheets Dim Ar As Worksheet Dim nr As Worksheet Set Ar = ThisWorkbook.Sheets("sheetAr") Set nr = ThisWorkbook.Sheets("Sheetnr") 'Source workbooks Dim FolderPath As String Dim Filename As String Application.ScreenUpdating = False FolderPath = Environ("userprofile" & "\\Desktop\\Copy") Filename = Dir(FolderPath & "*.xlsx*") Do While Filename <> "" Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True Dim ws As Worksheet Dim AW As Workbook Set AW = ActiveWorkbook Set ws= ActiveWorkbook.Sheets("Job") For Each AW In ws AW.Activate Cells.ShownAll ws.Copy Ar Next AW Workbooks(Filename).Close savechanges = True Filename = Dir() Loop Application.ScreenUpdating = True End Sub

Answer 1

FolderPath = Environ("userprofile" & "\\Desktop\\Copy")应该是FolderPath = Environ("userprofile") & "\\Desktop\\Copy\\" 。 For Each AW In ws没有意义，因为AW是工作簿而ws是工作表。 您可能指的是For Each ws in AW但如果只有Job sheet 是源，则无需循环。 Workbooks(Filename).Close savechanges = True丢失:但由于工作簿以只读方式打开，因此没有任何更改可保存，因此请使用.Close savechanges := False 。

Option Explicit

Sub combine()
 
    Dim wb As Workbook, rng As Range
    Dim wsAr As Worksheet, wsSrc As Worksheet
    Dim FolderPath As String, Filename As String
    Dim iTargetRow As Long, c As Long, n As Long
    
    FolderPath = Environ("userprofile") & "\Desktop\Copy\"
    Filename = Dir(FolderPath & "*.xlsx*")
 
    ' destination worksheet
    Set wsAr = ThisWorkbook.Sheets("sheetAr")
    iTargetRow = wsAr.UsedRange.Row + wsAr.UsedRange.Rows.Count

    Application.ScreenUpdating = False
    Do While Filename <> ""
        Set wb = Workbooks.Open(Filename:=FolderPath & Filename, ReadOnly:=True)
        Set wsSrc = wb.Sheets("Job")
        Set rng = wsSrc.UsedRange
        
        rng.Copy wsAr.Cells(iTargetRow, rng.Column)
        iTargetRow = iTargetRow + rng.Rows.Count
        wb.Close savechanges:=False ' opened read only
        Filename = Dir()
        n = n + 1
     Loop
     Application.ScreenUpdating = True
     MsgBox n & " workbooks scanned", vbInformation
End Sub