こんな事かな？

Sub test()
    Dim r As Range, Title, DT As Date, OUT(1 To 3)
    Dim i As Long, CL As Long, Pos As Long
    Dim WsOut As Worksheet
    
    Set WsOut = Sheets("Sheet2")
    WsOut.UsedRange.ClearContents
    WsOut.Range("A1:C1") = Array("日付", "カテゴリー", "数量")
    
    With Sheets("Sheet1")
        Set r = .Range("A1").CurrentRegion
        Title = r.Rows(1)
        Pos = 1
        For i = 2 To r.Rows.Count
            DT = .Cells(i, "A").Value
            
            For CL = 2 To r.Columns.Count
                If .Cells(i, CL) <> "" Then
                    Pos = Pos + 1
                    OUT(1) = DT
                    OUT(2) = Title(1, CL)
                    OUT(3) = .Cells(i, CL)
                    WsOut.Cells(Pos, "A").Resize(1, 3) = OUT
                End If
            Next CL
        Next i
    End With
End Sub

<Sheet1 シート　サンプル>　　　　　　　　　  <Sheet2 シート　結果図>
行 ____A____ ___B___ ___C___ ___D___ _E_     行 ____A____ _____B_____ __C__
 1 日付      リンゴ  みかん  ばなな  梨       1 日付      カテゴリー  数量 
 2  2023/1/1    10      20      30            2  2023/1/1 リンゴ         10
 3 2023/5/11    11      21           40       3  2023/1/1 みかん         20
                                              4  2023/1/1 ばなな         30
                                              5 2023/5/11 リンゴ         11
                                              6 2023/5/11 みかん         21
                                              7 2023/5/11 梨             40


この記事にはVBAのコードが含まれています。

緑の太文字→注釈
茶色の太文字→条件分岐
赤の太文字→ループ
青の太文字→その他

＞�@変数の「Pos」は　どういう意味でしょうか。
書き込みすべき行番号(行位置。行ポジション）です。
変数を RowToWrite としたら分かり易いですか。

＞�A日付がカテゴリー分　貼付けされるのはどの部分でしょうか。
    WsOut.Cells(Pos, "A").Resize(1, 3) = OUT

1行ずつ書き出しています。

OUTは書き出すべきデータの配列です。(1行分だけ）

例： {2023/1/1,リンゴ,10}

半平太さん　早々の回答ありがとうございます。
�@は、理解できたのですが、
�Aは、わかりにくいです。

以下、下記の部分のコードを読み解いたのですが…。

For i = 2 To r.Rows.Count
            DT = .Cells(i, "A").Value
            
            For CL = 2 To r.Columns.Count
                If .Cells(i, CL) <> "" Then
                    Pos = Pos + 1
                    OUT(1) = DT
                    OUT(2) = Title(1, CL)
                    OUT(3) = .Cells(i, CL)
                    WsOut.Cells(Pos, "A").Resize(1, 3) = OUT
                End If
            Next CL
        Next i

Sheet1の2行目から行数分だけ繰り返す。
DTはA1

2列目から列数ぶんだけ繰り返す
空白の列がある場合は抜ける
書き込む行は1行ずつ増加
Sheet2の1列2行目以降には　日付
Sheet2の2列2行目以降には　カテゴリの品名
Sheet2の3列2行目以降には　数量
A列の書き出す行番号の位置に1行3列でデータを貼付けていく…。

どうでしょうか。

＞どうでしょうか

良いと思います。