![複数のワークブックを 1 つのワークブックに結合する (終了)](https://rvso.com/image/1654370/%E8%A4%87%E6%95%B0%E3%81%AE%E3%83%AF%E3%83%BC%E3%82%AF%E3%83%96%E3%83%83%E3%82%AF%E3%82%92%201%20%E3%81%A4%E3%81%AE%E3%83%AF%E3%83%BC%E3%82%AF%E3%83%96%E3%83%83%E3%82%AF%E3%81%AB%E7%B5%90%E5%90%88%E3%81%99%E3%82%8B%20(%E7%B5%82%E4%BA%86).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`