同じフォルダにある複数のファイルから特定セルの数値を取得し、一覧にする

Sub GetCellValuesAndFileNames()
Dim folderPath As String
Dim fileExtension As String
Dim fileName As String
Dim wb As Workbook
Dim ws As Worksheet
Dim cellValue1 As Variant
Dim cellValue2 As Variant
Dim outputRow As Long

' 画面の更新を一時的に停止します
Application.ScreenUpdating = False

' フォルダのパスを指定します
folderPath = "C:\YourFolderPath\"
' ファイルの拡張子を指定します（例：".xlsx"）
fileExtension = ".xlsx"
' 出力先のシートを指定します
Set ws = ThisWorkbook.Sheets("Sheet1")
' 出力を開始する行を指定します
outputRow = 2

' フォルダ内の全てのファイルに対してループします
fileName = Dir(folderPath & "*" & fileExtension)
Do While fileName <> ""
    ' ファイルを開きます
    Set wb = Workbooks.Open(folderPath & fileName)
    ' データを取得します（A1セルとB1セルを例とします）
    cellValue1 = wb.Sheets(1).Range("A1").Value
    cellValue2 = wb.Sheets(1).Range("B1").Value
    ' ファイルを閉じます
    wb.Close False
    
    ' 取得したデータを出力します（ファイル名も一緒に出力します）
    ws.Cells(outputRow, 1).Value = fileName
    ws.Cells(outputRow, 2).Value = cellValue1
    ws.Cells(outputRow, 3).Value = cellValue2
    
    ' 次の行に出力する準備をします
    outputRow = outputRow + 1
    
    ' 次のファイルに進みます
    fileName = Dir
Loop

' 画面の更新を再度有効にします
Application.ScreenUpdating = True

MsgBox "データの取得が完了しました。"
End Sub