Sub Main()
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Set sh1 = ThisWorkbook.Sheets(1)
    Set sh2 = ThisWorkbook.Sheets(2)
    
    Dim y As Long
    Dim a As Variant
    With sh1
        y = .Cells(.Rows.Count, 2).End(xlUp).Row
        a = .Range(.Cells(1, 1), .Cells(y, 2))
        y = WorksheetFunction.CountA(.Columns(1))
    End With
    
    If y > 0 Then
        Dim x As Integer
        Dim z As Long
        Dim b As Variant
        ReDim b(1 To y, 1 To 6)
        z = 0
        For y = 1 To UBound(a, 1)
            If Not IsEmpty(a(y, 1)) Then
                z = z + 1
                x = 2
                b(z, 1) = a(y, 1)
            End If
            b(z, x) = a(y, 2)
            x = x + 1
        Next
    End If
    
    With sh2
        .Cells.Clear
        Dim r As Range
        Set r = .Cells(1, 1).Resize(UBound(b, 1), UBound(b, 2))
        r = b
        r.WrapText = False
        r.EntireColumn.AutoFit
    End With
End Sub