.png)
複数のワークブックを 1 つのワークブックに結合する必要があります。
ソース ワークブックには一意のシート名 = "job" があります
宛先ワークブックに複数のシート名がある
以下のコードには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`