エクセルで複数シートの一部分を一つにまとめたいのですが、どの部分がおかしいのかわかりません。

Question

エクセルで複数シートの一部分を一つにまとめたいのですが、どの部分がおかしいのかわかりません。
VB歴が浅いためひらめきません。よろしくお願いします。

Sub まとめ()

'変数を宣言
Dim i
Dim j
Dim k
Dim n

'セルに値が存在する数を変数ｎに代入
n = Cells(Rows.Count, "A").End(xlUp).Row

'シート1から31までを繰り返す処理
For j = 1 To 31

    '5からセルの値が空になるまでループする処理
    For k = 5 To n
    
        '５行目から順に入力される処理
        For i = 5 To Sheets("まとめ").Range("A10000").End(xlUp).Row + 1
        
            '["A" & i]が空白のときに実行される
            If Sheets("まとめ").Range("B" & i).Value = "" Then
                    
                '入力されているセルを「まとめ」シートに移動する
                Sheets("まとめ").Range("A" & i).Value = j
                Sheets("まとめ").Range("B" & i).Value = Sheets(j).Range("A" & k).Value
                Sheets("まとめ").Range("D" & i).Value = Sheets(j).Range("C" & k).Value
                Sheets("まとめ").Range("F" & i).Value = Sheets(j).Range("E" & k).Value
                Sheets("まとめ").Range("H" & i).Value = Sheets(j).Range("G" & k).Value
                Sheets("まとめ").Range("I" & i).Value = Sheets(j).Range("H" & k).Value
                Sheets("まとめ").Range("J" & i).Value = Sheets(j).Range("I" & k).Value
                Sheets("まとめ").Range("K" & i).Value = Sheets(j).Range("J" & k).Value
            
            End If
            
        Next
        
    Next
            
Next

End Sub
コード

Comments

[meg_]

> エクセルで複数シートの一部分を一つにまとめたいのですが、どの部分がおかしいのかわかりません。
現状の課題は何でしょうか？質問のコードを実行するとどのような結果となるのでしょうか？

[退会済みユーザー]

コードを実行すると空白のままで実行前と結果が変わらない状況です。
まずは実行結果が表示されるところまでできればいいと思っています。

Answer 1

Sub test()
    Dim wshResult As Worksheet
    Dim rngCopyFrom As Range
    Dim ixRow As Long
    Dim i As Long, j As Long
    
    Set wshResult = Worksheets("まとめ")
    ixRow = 2
    
    For i = 1 To 3
        '各シート転記元のセル範囲の取得
        With Worksheets(i).UsedRange
            Set rngCopyFrom = Application.Range(.Range("A5"), .Cells(.Cells.Count))
        End With
        'コピー元の行数を数える
        j = rngCopyFrom.Rows.Count
        
        '列毎の転記
        With wshResult.Cells(ixRow, 1).Resize(j)
            .Columns("A").Value = Worksheets(i).Name
            .Columns("B").Value = rngCopyFrom.Columns("A").Value
            .Columns("D").Value = rngCopyFrom.Columns("C").Value
            .Columns("F").Value = rngCopyFrom.Columns("E").Value
            .Columns("H").Value = rngCopyFrom.Columns("G").Value
            .Columns("I:K").Value = rngCopyFrom.Columns("H:J").Value
        End With
        
        '次の転記先行番号の用意
        ixRow = ixRow + j
    Next
End Sub

For　～　Nextを入れ子にしてインデックス番号をごねごね作って、
ぐるぐるループするとわけわかんなくなりますよね。

一括でできるところは一括でまとめて、
セルの読み書きの回数をできるだけ少なくすることで、
読みやすくなるし、処理の高速化も見込めます。

そのためには、セル範囲の表現方法を学ぶとともに、
「オブジェクト変数」を上手く使えるようになるとよいかと思います。

あと、複数シートを扱う場合は、
どのシートの話かも明示する必要があります。

Answer 2

少し触ってみましたが気になる点を複数点

'セルに値が存在する数を変数ｎに代入
n = Cells(Rows.Count, "A").End(xlUp).Row

このタイミングでworksheetの指定がありません。
そのためactivesheetでの参照になっていると思われます。
また、値を取得するタイミングがforループの中に組み込まれていないため、この値は初回に取得すると更新されません。

'シート1から31までを繰り返す処理
For j = 1 To 31

と書いていますがWorksheets(j)といった記述が一切ないためsheet1からsheet31を参照していません。
この下にn = worksheets(j).Cells(Rows.Count, "A").End(xlUp).Rowと書けば動きはしますが、この場合はシートの順番で指定になるのでfor Eachで全シート巡回した方が想定外の動きになりません。
（一番左端にまとめがあったり勝手にシートを動かされたりするとバグる）

    '5からセルの値が空になるまでループする処理
    For k = 5 To n

最初の点に記載があるようにアクティブシートのA列を一回だけ参照しているため、例えばnの値が1であればループの中に入らずそのまま終了します。

        '５行目から順に入力される処理
        For i = 5 To Sheets("まとめ").Range("A10000").End(xlUp).Row + 1

Range("A10000")と書いてあるので末尾を取得したいのだと思いますが、Rows.Countなら正確な末尾を取得します。（一行目で使用しています）
2007以降なら1048576、2003なら65536になります。

[追記]
セルの指定はRange("A"&i)みたいなA1形式よりもCells(1,i)みたいなR1C1形式の方が使いやすいので慣れた方がいいです。
Range(cells(1,1),Cells(3,1))で複数範囲も指定できます。