開いた複数の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
コメントを残す