VBAで複数シートのA2セルの値をサマリシートに転記する方法

VBAを使用して、フォルダ内のエクセルファイルから各シートの名称をサマリシートに転記する方法は一般的ですが、今回はそれに加えて、各シートのA2セルの値もサマリシートに転記する方法について解説します。

1. 基本的なコードの流れ
2. サマリシートにシート名とA2セルの値を転記するコード
3. コードの解説
4. まとめ

1. 基本的なコードの流れ

まず、指定されたフォルダ内のExcelファイルを順番に開き、各シートの名前をサマリシートに転記し、そのシートのA2セルの値も転記するための基本的なコードを作成します。

2. サマリシートにシート名とA2セルの値を転記するコード

以下のコードは、シート名をサマリシートに転記する部分に加えて、A2セルの値をQ列に転記する処理を追加しています。

Dim ws As Worksheet
Dim folPath As String, buf As String

folPath = ThisWorkbook.Path
buf = Dir(folPath & "\" & "*.xlsx*")
Do Until buf = ""
    Workbooks.Open Filename:=folPath & "\" & buf, ReadOnly:=True
    For Each ws In ActiveWorkbook.Worksheets
        With ThisWorkbook
            ws.Copy after:=.Worksheets(.Worksheets.Count)
            With .Worksheets("サマリシート")
                Dim shName As Range
                Set shName = .Cells(Rows.Count, "P").End(xlUp).Offset(1)
                If shName.Row < 6 Then Set shName = .Range("P6")
                shName.Value = ActiveSheet.Name
                .Hyperlinks.Add shName, "", "'" & ActiveSheet.Name & "'!A1"
                ' A2セルの値をQ列に転記
                .Cells(shName.Row, "Q").Value = ws.Range("A2").Value
            End With
        End With
    Next ws
    Sheets("サマリシート").Range("P1").Value = Workbooks(buf).Name
    Workbooks(buf).Close savechanges:=False
    Exit Do
    buf = Dir()
Loop

MsgBox "シート挿入完了"

このコードでは、各シートの名前をP列に転記するだけでなく、A2セルの値をサマリシートのQ列に転記しています。