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