2022年9月21日水曜日

複数のExcelファイルのシートをひとまとめにする

必要に応じ都度作っている気がするのでテンプレとして残しておきます。 概略:複数のExcelファイルのシートを全部自分の場所へコピーしてくる 備考:エラーハンドリングなどはしてません
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

0 件のコメント: