February 20, 2014

Excel VBA で全てのシートのデータをひとつにまとめたいときに。

シートが数十あって、どうにも手を付けようがないので、マクロを書いた方が思って作ったもの。
「Excel VBA シート まとめる」などとすると、色々出てくるのだけれど、今一つ欲しいものにしっくりこなかったので自分で作ることにした。


仕様

  • 実行すると新しくシートを1枚作成します。
  • 作成したシートに、他のシートのデータをコピーしてきます。
    (コピー範囲はA1セルを始点として、UsedRangeを使って取得できる最右下セルまでの範囲。)
  • コピーするときに、1列目にはシート名が入力されます。
    (これが実は欲しかった機能…シート名がついてないと何のデータか分からなくなるような構造の元データだったので。)

コード


Sub consolidateAllSheets()
    'シート名を1列目に記入し、2列目以降に各シートのデータを結合するマクロ

    Dim targetSheet As Worksheet, outputSheet As Worksheet
    Dim startCell As Range, endCell As Range
    Dim fromRange As Range, toRange As Range
    
    Dim i As Long
    i = 0
    
    'コピー先のシートを作成
    Set outputSheet = Worksheets.Add(after:=ActiveSheet)
    
    'すべてのシートから1シートごとに、コピー元シートとして、コピー先シートへのコピーを繰り返す
    For Each targetSheet In Sheets
        '但し、コピー先シートはコピー元に含まない(シート名で判断)
        If targetSheet.Name <> outputSheet.Name Then

            'シート名をコピー元からコピー先へコピー
            outputSheet.Cells(1 + i, 1) = targetSheet.Name

            'コピー元の範囲を取得
            With targetSheet
                Set startCell = .Cells(1, 1)
                Set endCell = .UsedRange.Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)
                
                Set fromRange = .Range(startCell, endCell)
            End With

            'コピー先の範囲を取得
            Set toRange = outputSheet.Cells(1 + i, 2)

            'コピー元からコピー先へ内容をコピー
            fromRange.Copy Destination:=toRange
            
            '次のシートのコピー先位置を示すオフセットを更新(次のシートのデータを下の行にコピーする)
            i = i + fromRange.Rows.Count
        End If
    Next
End Sub

No comments :

Post a Comment