Option Explicit
Public Sub MergeDocuments()
Const listIndex As String = "A"
Dim i As Long
Dim list As Collection
Dim wk As String
Dim currentwb As Excel.Workbook
Dim currentws As Worksheet
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Set list = New Collection
'Step 1 シートの内容から対象ファイルのフルパスを取得する
i = 1
Do
wk = ActiveSheet.Range(listIndex & CStr(i)).Cells(1, 1).Value
If Len(wk) > 0 Then
list.Add wk
Else
Exit Do
End If
i = i + 1
Loop
Set currentwb = ThisWorkbook
Set currentws = ActiveSheet
'Step 2 ファイルを順次開き、自分にコピーする
Application.DisplayAlerts = False
For i = 1 To list.Count
wk = list(i)
Set wb = Excel.Application.Workbooks.Open(wk, False, True)
For Each ws In wb.Worksheets
ws.Copy before:=currentwb.Worksheets(currentws.Index)
Next
wb.Close
Set wb = Nothing
Next
MsgBox "Success"
End Sub
2022年9月21日水曜日
複数のExcelファイルのシートをひとまとめにする
必要に応じ都度作っている気がするのでテンプレとして残しておきます。
概略:複数のExcelファイルのシートを全部自分の場所へコピーしてくる
備考:エラーハンドリングなどはしてません
登録:
コメント (Atom)