列と行の名前（重複あり）が交差するセルに、データを入力したい

【やりたい内容】
1）元データのA列5行目～C列14行目の表から、3）結果（やりたい結果）のように、
名前(重複あり)が交差するセルに、日付と名前と数量のデータを入力したいので、
2-2）VBAプログラムを作成し実行するのですが、結果が、2-1)結果となります。
【質問】
以下の①②が上手く行きませんので、何方か教えて頂けないでしょうか！
VBA初心者ですので、宜しくお願いします。
又は、他の手法のプログラムで良い方法が有りましたら、ご指導お願いします。
①　行の名前が複数ある場合の記述方法が分かりません。（列の名前は複数無し）
②　行に名前（メロン）が有るのですが、列に名前が無い場合は、記入無しにしたい。

1）元データ
　　A列　　B列　　　C列
5行　日付 名前 数量
6行　 5/1 　みかん 750
7行　 5/2 りんご 300
8行　 5/2 いちご 900
9行　 5/3 すいか 850
10行　5/5 いちご 700
11行　5/6 みかん 1200
12行　5/7 いちご 1200
13行　5/10 メロン 1500
14行　5/15 すいか 1200

2-1）結果
　　　D列　E列　F列　G列　H列　I列　J列　Ｋ列　L列　M列　N列　O列　P列　Q列　R列　S列
2行　みかん りんご いちご すいか
5行　日付 数量 状況 名前 日付 数量 状況 名前 日付 数量 状況 名前 日付 数量 状況 名前
6行 5/1 1200 　　　みかん
7行　 　　　　　　　　　　　5/2 300　　　りんご
8行　 　　　　　　　　　　　　　　　　　　　　　5/2 1200　　　いちご
9行　 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　5/3 1200　　すいか
10行
11行
12行
13行　 5/10 1500　　　メロン
14行

2-2）VBAプログラム
Sub クロス入力()
Dim i, k, TgRow, TgCol As Long
MaxRow = Cells(Rows.Count, 2).End(xlUp).Row '最終行の取得
MaxCol = Cells(2, Columns.Count).End(xlToLeft).Column '最終列の取得
'データ削除
If MaxRow > 5 Then
Range(Cells(6, "D"), Cells(MaxRow, MaxCol)).ClearContents
End If
'データ抽出
For Each k In Range("B6:B" & MaxRow)
For i = 6 To MaxRow
If Cells(i, 2) = k Then
TgRow = i
Exit For
End If
Next i
For i = 4 To MaxCol
If Cells(2, i) = k Then
TgCol = AAi
Exit For
End If
Next i
'データ出力
Cells(TgRow, TgCol).Value = k.Offset(0, -1).Value
Cells(TgRow, TgCol).Offset(0, 3).Value = k.Value
Cells(TgRow, TgCol).Offset(0, 1).Value = k.Offset(0, 1).Value
Next k
End Sub

3）結果 （やりたい結果）
　　　D列　E列　F列　G列　H列　I列　J列　Ｋ列　L列　M列　N列　O列　P列　Q列　R列　S列
2行　みかん りんご いちご すいか
5行　日付 数量 状況 名前 日付 数量 状況 名前 日付 数量 状況 名前 日付 数量 状況 名前
6行 5/1 750 みかん
7行　 　　　　　　　　　　　5/2 300　　　りんご
8行　 　　　　　　　　　　　　　　　　　　　　　5/2 900　　　いちご
9行　 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　5/3 850　　すいか
10行　　　　　　　　　　　　　　　　　　　　　　5/5 700　　　いちご
11行　5/6 1200　　みかん
12行　　　　　　　　　　　　　　　　　　　　　　5/7 1200　　いちご
13行
14行　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　5/15 1200　　すいか

No.3 回答者： めぐみん_ 回答日時： 2022/06/12 17:30

回答ではありません。

メロンにつきましてはこのように説明が書かれてます。

＞②　行に名前（メロン）が有るのですが、列に名前が無い場合は、記入無しにしたい。

失礼しました。

No.2 回答者： tatsumaru77 回答日時： 2022/06/12 15:54

補足要求です。

１．メロンが結果（やりたい結果）にありませんが、それは意図した結果でしょうか。
２．結果（やりたい結果）をNo1の方のように画像で添付していただけませんでしょうか。

No.1 回答者： fujillin 回答日時： 2022/06/12 12:10

こんにちは

せっかくのご説明ですが、ずれているので表がどうなっているのかよくわかりません。
ですので、勝手に妄想してみました。
（妄想なので、当たるも八卦です。）

＞①　行の名前が複数ある場合の記述方法が分かりません。
元データで名前が複数あるとは思えませんが、同じ行に表示すれば良いということではないのでしょうか？
（違っている場合は、ハズレですので、以下は無視してください）
＞②　行に名前（メロン）が有るのですが、～～
2行目と照合すれば良さそうに思います。


以下は、ご提示の考え方とはまったく異なる方法ですが（どうせ妄想ですので）、実行すると結果は添付図のようになります。
（なさりたいことと一致しているのかどうかは、当方にはわかりません。）
※ とりあえず、D2:G2の範囲は固定にしてあります。

Sub Q12993113()
Dim rw As Long
Const f1 = "=IFERROR(IF(MATCH($B6,$D$2:$G$2,0)*4=INT"
Const f2 = "(COLUMN()/4)*4,INDEX($A6:$C6,CHOOSE"
Const f3 = "(MOD(COLUMN(),4)+1,1,3,0,2)),""""),"""")"

rw = Cells(Rows.Count, 1).End(xlUp).Row
If rw < 6 Then Exit Sub
With Range("D6:S6").Resize(rw - 5)
.FormulaLocal = f1 & f2 & f3
.Value = .Value
End With
End Sub