複数のExcelファイルから指定されたデータ（一定間隔で行が飛んでいる）を統合するマクロ

説明: 同一フォルダ内のすべてのExcelファイルから、A列の2行目から32行目までのデータを5行おきに抽出し、まとめ用シートに行列を入れ替えて3列おきに貼り付ける.

Sub 隔行のデータコピー()
    Dim folderPath As String
    Dim fileName As String
    Dim sourceWb As Workbook
    Dim sourceWs As Worksheet
    Dim destWs As Worksheet
    Dim i As Integer
    Dim destRow As Integer
    Dim destCol As Integer
    Dim rowOffset As Integer

    ' 現在のマクロブックが保存されているフォルダパスを取得
    folderPath = ThisWorkbook.Path & "/"

    ' まとめ用シートを設定
    Set destWs = ThisWorkbook.Sheets(1)

    ' B列の最初の空白セルを探して貼り付け開始位置を決定
    destRow = destWs.Cells(destWs.Rows.Count, 2).End(xlUp).Row + 1 ' B列の最初の空白セルを見つける
    destCol = 2 ' B列から貼り付け開始

    ' フォルダ内のすべてのファイルを取得
    fileName = Dir(folderPath & "*.xlsx") ' .xlsxファイルのみ対象

    If fileName = "" Then
        MsgBox "フォルダ内にExcelファイルが見つかりません！", vbExclamation
        Exit Sub
    End If

    ' 同じフォルダ内のすべての.xlsxファイルを処理
    Do While fileName <> ""
        ' このブック自身を除外
        If fileName <> ThisWorkbook.Name Then
            ' ソースファイルを開く
            Set sourceWb = Workbooks.Open(folderPath & fileName)
            Set sourceWs = sourceWb.Sheets(1) ' ソースファイルの1番目のシートを使用

            ' A列の2行目から32行目まで5行おきにデータを取得
            For i = 2 To 32 Step 5
                ' 3行分のデータを行列を入れ替えて横に貼り付け
                For rowOffset = 0 To 2
                    destWs.Cells(destRow, destCol + rowOffset).Value = sourceWs.Cells(i + rowOffset, 1).Value
                Next rowOffset

                ' 次のファイルのデータは3列おきに貼り付ける
                destCol = destCol + 3
            Next i

            ' 次の行に移動 (次のファイルのデータはその下に貼り付け)
            destRow = destRow + 1 ' 3行分貼り付けたので、1行進める
            destCol = 2 ' 次のファイルはB列から再スタート

            ' ソースファイルを閉じる
            sourceWb.Close SaveChanges:=False
        End If

        ' 次のファイルを取得
        fileName = Dir
    Loop

    MsgBox "データの統合が完了しました！", vbInformation
End Sub