フォルダの中のExcelファイルを取得して、そのファイルのD行をリストにしたい。【VBA】

経緯

タイトルのままですが、VBAでフォルダの中のExcelファイルを取得して、そのファイルのD行をリストにしたくて、

今回勉強しました。

Do while Loopを使う

まず、コードを書きます。

Sub GetExcelFiles()

    Dim FolderPath As String
    Dim FileName As String
    Dim OutputWorkbook As Workbook
    Dim OutputWorksheet As Worksheet
    Dim SourceWorkbook As Workbook
    Dim SourceWorksheet As Worksheet
    Dim NextOutputRow As Long
    Dim LastRow As Long
    Dim FolderPath As String

    ' 入力するフォルダパス
    FolderPath = "C:\Path\to\your\folder\"
    ' 出力するExcelワークブックとワークシートを作成
    Set OutputWorkbook = ThisWorkbook
    Set OutputWorksheet = OutputWorkbook.Sheets("Sheet1")
    ' 次の出力行を指定
    NextOutputRow = 1

    ' FolderPathで指定されたフォルダ内のすべてのExcelファイル (*.xls*, *.xlsx*, *.xlsm*) をループする
    FileName = Dir(FolderPath & "\*.xls*")
    Do While FileName <> ""
        ' Excelファイルを開く
        Set SourceWorkbook = Workbooks.Open(FolderPath & FileName)
        ' ここでは最初のワークシートを使用します
        Set SourceWorksheet = SourceWorkbook.Sheets(1)
        ' そのシートの最終行を見つける
        LastRow = SourceWorksheet.Cells(SourceWorksheet.Rows.Count, "D").End(xlUp).Row
        ' データを出力シートにコピー
        SourceWorksheet.Range("D1:D" & LastRow).Copy OutputWorksheet.Range("A" & NextOutputRow)
        ' 次の出力行を更新
        NextOutputRow = NextOutputRow + LastRow
        ' Excelファイルを閉じる
        SourceWorkbook.Close SaveChanges:=False
        ' 次のファイルを見つける
        FileName = Dir
    Loop

End Sub

これを実行する前に、”C:\Path\to\your\folder”を対象とするフォルダのパスに書き換えてください。また、出力するデータは”Sheet1″という名前のシートに書き込まれますので、存在しない場合は適宜作成してください。もしくは別のシート名に変更しても構いません。

このスクリプトは、指定されたフォルダ内のすべてのExcelファイルを開き、それぞれのファイルの最初のシートのD列のデータをコピーし、出力用のExcelワークシートに追加します。

参考になれば、幸いです。

ここまで読んでいただきありがとうございました。