Sub CopyDatesToCell()
Dim ws As Worksheet
Dim lastRow As Long
Dim dateList As String
Dim i As Long
' 対象のシートを設定
Set ws = ThisWorkbook.Sheets("欲しいリスト") ' シート名を適切なものに変更
' B列の最終行を取得
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
' 日付を転記するための文字列を初期化
dateList = ""
' B列をループして日付をH5セルに転記
For i = 1 To lastRow
If ws.Cells(i, "B").Value = "B9491" Then
' 該当するセルが見つかった場合、日付を取得してdateListに追加
If dateList = "" Then
dateList = Format(ws.Cells(i, "A").Value, "mmdd")
Else
dateList = dateList & "・" & Format(ws.Cells(i, "A").Value, "d")
End If
End If
Next i
' H5セルに日付を転記
ws.Range("H5").Value = dateList
End Sub