根据您提供的屏幕截图，类似的操作应该适合您。请确保根据需要更新工作表名称，如果您希望目标位于其他位置，请调整目标。（如果您希望目标位于其他工作表，则需要添加新的工作表变量）。

Sub repeat_items()
    
    'Declare and set variables
    Dim ws As Worksheet:    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Dim rData As Range:     Set rData = ws.Range("A1").CurrentRegion
    Dim rDest As Range:     Set rDest = ws.Range("H2")
    If rData.Rows.Count = 1 Then Exit Sub  'No data
    Dim aData As Variant:   aData = rData.Value
    
    'Prepare results array
    Dim aResults() As Variant, iResult As Long
    ReDim aResults(1 To WorksheetFunction.Sum(rData), 1 To 1)
    
    'Prepare loop variables
    Dim i As Long, j As Long, k As Long, sResult As String
    
    'Loop through each row
    For i = 2 To UBound(aData, 1)
        sResult = vbNullString      'Reset the result string to null
        
        'Loop through each column
        For j = 1 To UBound(aData, 2)
            
            'Check if the value in the data is a number or not
            If Not IsNumeric(aData(i, j)) Then
                'Not a number, add the text to the result string with an "_"
                sResult = sResult & aData(i, j) & "_"
            Else
                'This is a number, loop that number of times
                For k = 1 To aData(i, j)
                    'Each time, add this column header to the result string and append it to the results array
                    iResult = iResult + 1
                    aResults(iResult, 1) = sResult & aData(1, j)
                Next k
            End If
        Next j
    Next i
    
    rDest.Resize(rDest.CurrentRegion.Rows.Count).ClearContents
    rDest.Resize(UBound(aResults, 1)).Value = aResults  'Output results
    
End Sub