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)
0 件のコメント:
コメントを投稿