for nextの2重ループ

Question

前提・実現したいこと

VBA　マクロです
for next　において変数を２つ使用して、2重ループの構成を作成したのですが、うまくいきません

この図の左側（sheet1）をマクロを使って右側（sheet2）のようになればOKです

発生している問題・エラーメッセージ

下のマクロを起動すると上図のような結果になります。
コード自体、どこが間違っているかが全然わかりません。

該当のソースコード

VBA

Sub test()
'
' test Macro
'

'
＃繰り返しができるようにまず、sheet1のブドウとイチゴを上にあげる
    Range("C4").Value = Range("C6").Value
    Range("C5").Value = Range("C7").Value
    
＃リンゴはシンプルにコピペ（この方法以外おもいつかない）   
　  Range("C1").Select
    Selection.Copy
　　ActiveSheet.Next.Select
    Range("E1").Select
    ActiveSheet.Paste
    ActiveSheet.Previous.Select
    
＃変数作成
   Dim i, j As Long
   For i = 2 To 5
   For j = 3 To 9 Step 2
   
＃（2､C）から（5,C）までコピーするループ
   Cells(i, "C").Select
         Selection.Copy
         ActiveSheet.Next.Select

＃（3､A）から（9,A）まで貼り付けするループ
   Cells(j, "A").Select
         ActiveSheet.Paste
         ActiveSheet.Previous.Select
         
   Next j
 　Next i

End Sub

試したこと

For i = 2 To 5
を
For i = 2 To 4
にしたところ、
4行目のブドウがコピーされて、ブドウが4つ続きました。

この結果、恐らく「i」が先に繰り返して、
終わった後に、「j」が始まる
という構図になっているとわかりました。

「i」と「j」が同時に始まって、同時に終わるようなマクロを作りたいです。

補足情報（FW/ツールのバージョンなど）

上記以外に容量が少なく、もっとスマートなやり方などあれば、ご教授お願いします。
Excel2013です

Comments

[meg_]

コードは「コードの挿入」で記入してください。

Answer 1

Sub test()
    '＃繰り返しができるようにまず、sheet1のブドウとイチゴを上にあげる
    Range("C4:C5").Delete Shift:=xlShiftUp

    '＃変数作成
    Dim i As Long, j As Long, k As Long
    j = 1
    
    '#コピーするループ
    For i = 1 To 5
        If i = 1 Then
            k = 5
        Else
            k = 1
        End If
        
        ActiveSheet.Cells(i, 3).Copy ActiveSheet.Next.Cells(j, k)
        
        j = j + 2
    Next i
End Sub

こんな感じでしょうか？

僕なら以下のように書くかなぁ。。。。

Sub test2()
    Dim rngValue As Range
    Dim rngResults As Range
    Dim c As Range
    Dim ixRow As Long
    Dim ixCol As Long
    
    Set rngValue = ActiveSheet.Range("C:C").SpecialCells(xlCellTypeConstants)
    Set rngResults = rngValue.Worksheet.Next.Cells(1, 1)
    ixRow = 1
    
    For Each c In rngValue
        ixCol = IIf(ixRow = 1, 5, 1)
        rngResults(ixRow, ixCol).Value = c.Value
        ixRow = ixRow + 2
    Next
End Sub

Comments

[GytaAmies]

初心者なのでわからないコードがいくつかありますが、頑張って理解して、業務効率化を働きます。
大変参考にさせていただきます。ありがとうございました。

Answer 2

「i」と「j」が同時に始まって、同時に終わるようなマクロを作りたいです。

Forループを１つ(i)にして、そのループの中でjをインクリメントしてください。

質問のコードでは、「Ｃ２をコピー→３Ａに張り付け」「Ｃ２をコピー→５Ａに張り付け」「Ｃ２をコピー→７Ａに張り付け」・・・「５Ｃをコピー→５Ａに張り付け」「５Ｃをコピー→７Ａに張り付け」「５Ｃをコピー→９Ａに張り付け」となり、上書きされて最終的に５Ｃの値のみが残ります。

Comments

[GytaAmies]

大変参考にさせていただきます。ありがとうございました。