マクロ（データ取得と転記）について教えてください

こんにちわ。マクロについて教えてください。

やりたい事は、Sheet1の品名別のデータをSheet2の品名それぞれの列へ日付が一致したセルでへ転記です。（Sheet1は月毎で、Sheet2は日付がカレンダーのように下へ続く予定です）
行先は月毎で変わるので、2行目の品名が一致したら取得するように色々と試行錯誤しながら下のコードを書きましたが、うまく取得できません。
ご教示のほど、宜しくお願いします。

Sub TEST()

Dim i As Long
Dim j As Long
Dim cnt As Long

Worksheets(1).Select

cnt = 3

For i = 5 To Cells(Rows.Count, 2).End(xlUp).Row

For j = 3 To Cells(4, Columns.Count).End(xlToLeft).Column


If Worksheets(1).Cells(2, j) = "りんご" And Worksheets(1).Cells(i, j) <> "" Then

Worksheets(2).Cells(cnt, 3) = Worksheets(1).Cells(i, j)


ElseIf Worksheets(1).Cells(2, j) = "みかん" And Worksheets(1).Cells(i, j) <> "" Then

Worksheets(2).Cells(cnt, 4) = Worksheets(1).Cells(i, j)


ElseIf Worksheets(1).Cells(2, j) = "ぶどう" And Worksheets(1).Cells(i, j) <> "" Then

Worksheets(2).Cells(cnt, 5) = Worksheets(1).Cells(i, j)


ElseIf Worksheets(1).Cells(2, j) = "いちご" And Worksheets(1).Cells(i, j) <> "" Then

Worksheets(2).Cells(cnt, 6) = Worksheets(1).Cells(i, j)

cnt = cnt + 1

End If

Next j
Next i

Worksheets(2).Select

End Sub

質問者からの補足コメント

• 補足します。
  
  Sheet1は、月毎で更新しますので1月になれは12月の日付は無くなります。
  Sheet2は、12月の日付はなくならず、その下に1月、2月・・・と続いていきます。

    補足日時：2022/12/24 15:26

• 画像が不鮮明で申し訳ありません。
  
  補足します。
  Sheet1の品名が空白の列（G列・L列・P列・隠れてますがW列も）はSheet2に集計はしません。コードを「その他」として、配送しない営業用としてカウントしているだけです。

    補足日時：2022/12/24 16:47

No.3 ベストアンサー 回答者： tatsumaru77 回答日時： 2022/12/24 17:29

こちらに投稿するとエラーになるので下記にアップしました。

https://ideone.com/Y3nVor

この回答へのお礼

ありがとうございます！
理想通りです！素晴らしいです！

1つ1つ解読しながら、知識向上に努めます。

お礼日時：2022/12/24 21:21

No.2 回答者： tatsumaru77 回答日時： 2022/12/24 15:28

Sheet1のG列は品名が空白になってます。

G列の数値はSheet2へ集計しないということでしょうか。（L列、P列も同様）

画像が不鮮明なのでわからないのですが、G列、L列、P列はどのような意味なのでしょうか。

No.1 回答者： tatsumaru77 回答日時： 2022/12/24 12:28

現在12月の日付が設定されていますが、来年の１月になった場合、

Sheet1,Sheet2ともに、１月の日付が設定されると考えて良いでしょうか。
（１２月の日付はなくなる）