VBAコード解説: 最終行までのデータをコピーするマクロ

日付:


VBAコード解説: 最終行までのデータをコピーするマクロ

はじめに

　この記事では、VBA（Visual Basic for Applications）を使用して、指定されたフォルダ内のExcelファイルから最終行までのデータをコピーする方法について解説します。具体的には、以下の内容をカバーします。

  1. コードの目的と背景
  2. フォルダ内のExcelファイルを処理する方法
  3. 最終行までのデータをコピーする手順
  4. エラーハンドリングの実装
  5. サンプルコードと実行結果

コードの目的と背景

「まとめ.xlsm」以外のExcelファイルから2行目から最終行までのデータをコピーして、ワークブック「まとめ.xlsm」のシート1の先頭行に挿入するマクロを作成します。この処理は、複数のExcelファイルからデータを集約する際に便利です。

フォルダ内のExcelファイルを処理する方法

  1. フォルダパスを指定します。
  2. フォルダ内の全てのExcelファイルに対して処理を実行します。
  3. 「まとめ.xlsm」以外のファイルのみ処理します。

最終行までのデータをコピーする手順

  1. 外部のExcelファイルを開きます。
  2. 外部ファイルの最終行を取得します。
  3. 2行目から最終行までのデータをコピーします。
  4. 「まとめ.xlsm」のシート1の先頭行に挿入します。

エラーハンドリングの実装

外部ファイルが存在しない場合やエラーが発生した場合に適切に処理します。

サンプルコードと実行結果

　以下にサンプルコードを示します。詳細な実装は、ご自身の環境に合わせて行ってください。

Sub InsertFourthRowToFirstRow2()
    Dim folderPath As String
    Dim ws As Worksheet
    Dim i As Long
    Dim fileName As String
    Dim externalWorkbook As Workbook

    ' フォルダパスを指定
    folderPath = ThisWorkbook.Path
    
    ' シート名を適切に変更
    Set ws = ThisWorkbook.Sheets("Sheet1")

    ' フォルダ内の全てのファイルに対して処理を実行
    fileName = Dir(folderPath & "\*.xls*")
    Do While fileName <> ""
        ' 「まとめ.xlsm」以外のファイルのみ処理
        If fileName <> "まとめ.xlsm" Then
            On Error Resume Next
            Set externalWorkbook = Workbooks.Open(folderPath & "\" & fileName)
            If Not externalWorkbook Is Nothing Then
                Dim lastRow As Long
                lastRow = externalWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
                externalWorkbook.Sheets(1).Rows(2 & ":" & lastRow).Copy
                ws.Rows(1).Insert Shift:=xlDown
                Application.CutCopyMode = False
                externalWorkbook.Close SaveChanges:=True
            End If
            On Error GoTo 0
        End If
        ' 次のファイルを処理
        fileName = Dir
    Loop
End Sub


サンプルコードの解説
1. フォルダパスの指定
最初に、処理対象のフォルダパスを指定します。ThisWorkbook.Path を使用して、現在のワークブックのフォルダパスを取得します。
folderPath = ThisWorkbook.Path

2. フォルダ内のExcelファイルを処理
Dir 関数を使用して、指定されたフォルダ内の全てのExcelファイルを順番に処理します。fileName には各ファイル名が格納されます。
fileName = Dir(folderPath & "\*.xls*")
Do While fileName <> ""
    ' 「まとめ.xlsm」以外のファイルのみ処理
    If fileName <> "まとめ.xlsm" Then
        ' 外部ファイルを開く処理
        ' ...
    End If
    ' 次のファイルを処理
    fileName = Dir
Loop

3. 外部ファイルを開く処理
Workbooks.Open メソッドを使用して、外部のExcelファイルを開きます。エラーハンドリングを適切に行い、ファイルが存在しない場合やエラーが発生した場合に処理をスキップします。
On Error Resume Next
Set externalWorkbook = Workbooks.Open(folderPath & "\" & fileName)
If Not externalWorkbook Is Nothing Then
    ' 最終行までのデータをコピーする処理
    ' ...
End If
On Error GoTo 0

4. 最終行までのデータをコピー
外部ファイルの最終行を取得し、2行目から最終行までのデータをコピーします。
Dim lastRow As Long
lastRow = externalWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
externalWorkbook.Sheets(1).Rows(2 & ":" & lastRow).Copy
ws.Rows(1).Insert Shift:=xlDown
Application.CutCopyMode = False

5. 外部ファイルを閉じる
処理が完了したら、外部ファイルを閉じます。
externalWorkbook.Close SaveChanges:=True


ご自身の環境に合わせて実装してみてください。