Posted by & filed under excel, メモ.

開いた複数のExcelブックを行単位でコピーし、1つのシートに連結するマクロ。 依頼があって書いた。

Option Explicit

Function writeRow(ByVal t As Range, ByVal s As Range) As Range
    s.Copy t
    Set writeRow = t.Cells(2)
End Function

Sub concatenate(ByVal target As Workbook, ByVal sources As Collection)
    Dim t As Range
    Dim src
    Set t = target.Sheets(1).Range("A1")
    For Each src In sources
        Dim srcsh As Worksheet
        For Each srcsh In src.Sheets
            Dim lastRow As Long
            Dim cur As Range
            Set cur = srcsh.Range("A1")
            lastRow = cur.SpecialCells(xlCellTypeLastCell).Row
            Do While cur.Row <= lastRow
                Set t = writeRow(t, cur.EntireRow)
                Set cur = cur.Cells(2)
            Loop
        Next
    Next
End Sub

Sub main()
    Dim target As Workbook
    Dim sources As New Collection
    Dim wb
    
    For Each wb In Application.Workbooks
        sources.Add wb
    Next

    Set target = Application.Workbooks.Add()
    
    concatenate target, sources
End Sub

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です