エクセルVBAで、「 クリップボード上にある文章から、エクセルシートにそれぞれ貼り付けしたい。

コメントいただいた要件を実行できるようにマクロを修正しました。

VBAでクリップボードを扱うための前準備

1. 開発 → マクロ → VisualBasic
2. VisualBasicEditerで ツール → 参照設定
3. 参照設定で Microsoft Forms 2.0 Object Library にチェックを入れてください。

Microsoft Forms 2.0 Object Libraryが見つからない場合は、以下のサイトを参考にしてください。
http://pc.k-solution.info/programming/vba/excelvba1.aspx

マクロ本体

クリップボードの内容に「」や「終わり」は含まれておらず、以下のようになっているとします。
数字の制限は設けていません。（メモリが許す限りOKのはず）
ただし、数字の次に、名前, 品物, 説明 のいずれかの文字があることが前提です。また、シート "ons" が存在していることが前提です。（シートの内容をクリアせず、そのまま代入するようにしてあります）

1名前
和歌山県産

1品物
みかん

1説明
とても
甘いです

2名前青森県産
2品物りんご
2説明無農薬です

ただし、次のようなクリップボードは正常に処理できません。
数字＋名前, 品物, 説明のいずれかの文字が同じ行になっていることが前提です。

1名前和歌山
県産

1品物
みかん

1説明とても
甘いです

マクロは次のようになります。

Option Explicit

'クリップボードの内容を取り出す
Function getClipBoard() As String
    Dim CB As Object
    Set CB = New DataObject
    With CB
        .GetFromClipboard
        getClipBoard = .GetText
    End With
End Function

Sub main()
    Dim str As String, items() As String
    Dim i As Long, j As Long, r As Long
    Dim re As Object
    Dim remat As Variant
    Dim key As String, val As String, name As String
    
    name = "ons"                                     'シート名
    str = getClipBoard()
    items = Split(str, vbCrLf)
    Set re = CreateObject("VBScript.RegExp")
    For i = LBound(items) To UBound(items)
        With re
            .Pattern = "([0-9]+)(名前|品物|説明)(.*)"
            .IgnoreCase = True
            .Global = True
            Set remat = .Execute(items(i))
            If remat.Count > 0 Then
                r = remat(0).SubMatches(0) + 1       '行番号
                key = remat(0).SubMatches(1)         '見出し
                val = remat(0).SubMatches(2)         'データ
                If (val = "") Then
                    i = i + 1
                    While (i <= UBound(items) And items(i) <> "")
                        val = val & items(i) & vbCrLf
                        i = i + 1
                    Wend
                    val = Left(val, Len(val) - 1)
                End If
                Select Case key
                    Case "名前"
                        Worksheets(name).Cells(r, 2) = val
                  Case "品物"
                        Worksheets(name).Cells(r, 3) = val
                    Case "説明"
                        Worksheets(name).Cells(r, 9) = val
               End Select
            End If
        End With
    Next i
    Set re = Nothing
End Sub