有很多方法可以解决这个问题。
使用Power Query，可在Windows Excel 2010+和Excel 365（Windows或Mac）中使用
使用Power Query

• 选择数据表中的某个单元格
• Data => Get&Transform => from Table/Range或from within sheet
• PQ编辑器打开时：Home => Advanced Editor
• 记下第2行中的表名称
• 将下面的M代码粘贴到您所看到的位置
• 将第2行中的Table名称更改回最初生成的名称。
• 阅读评论并浏览Applied Steps以了解算法

let

//change next line to reflect actual table name
    Source = Excel.CurrentWorkbook(){[Name="Table5"]}[Content],

//set the data types
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Column1", type text}, {"Column2", type text}}),

//Group by column1 = Column headers
//Generates list of column Contents for each column
    #"Grouped Rows" = Table.Group(#"Changed Type", {"Column1"}, {
        {"cols", each [Column2], type list} }),

    #"New Table" = Table.FromColumns(
        #"Grouped Rows"[cols], #"Grouped Rows"[Column1])

in #"New Table"

有很多方法可以做到这一点。这里有一个我已经测试过的：

Const NUM_ROWS_PER_GROUP = 6
Const NUM_ROWS = 12  ' This is also easy to calculate at runtime rather than a` constant.

Sub RowsToColumns()
     Dim iRow As Long
     Dim iRow2 As Long
     Dim iRow3 As Long
     Dim iCol As Long
     '
     ' Get the column headers first
     '
     iRow3 = NUM_ROWS + 2
     For iRow = 1 To NUM_ROWS_PER_GROUP
          iCol = iRow
          Me.Cells(iRow3, iCol) = Me.Cells(iRow, 1)
     Next iRow
     '
     ' Now the data
     '
     iRow3 = iRow3 + 1

     For iRow = 1 To NUM_ROWS Step NUM_ROWS_PER_GROUP
         For iRow2 = 1 To NUM_ROWS_PER_GROUP
             iCol = iRow2
             Me.Cells(iRow3, iCol) = Me.Cells(iRow + iRow2 - 1, 2)
         Next iRow2
         iRow3 = iRow3 + 1
     Next iRow
End Sub

例如，从第2行开始的A列和B列中的列表，从D2开始转置

Sub TransposeValues()
    Dim lastRow As Long, j As Long
    Dim dict As Object, key As Variant
    Dim rng As Range, nxt As Long, foundcell As Range
    Set dict = CreateObject("Scripting.Dictionary")
    Dim firstAddress
    
    nxt = 3
    lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = ActiveSheet.Range("A2:A" & lastRow)
    
    'Loop through column A and add unique values to dictionary
    For i = 2 To lastRow
        If Not dict.Exists(ActiveSheet.Cells(i, 1).Value) Then
            dict.Add Cells(i, 1).Value, 1
        End If
    Next i
    
    'Loop through dictionary keys and find corresponding values in column B
    For Each key In dict.Keys
        nxt = nxt + 1
        ActiveSheet.Cells(2, nxt).Value = key
        j = 2
        Set foundcell = rng.Find(What:=key, LookIn:=xlValues)
        If Not foundcell Is Nothing Then
            firstAddress = foundcell.Address
            Do
                ActiveSheet.Cells(j + 1, nxt).Value = foundcell.Offset(0, 1).Value
                j = j + 1
                Set foundcell = rng.FindNext(foundcell)
            Loop While Not foundcell Is Nothing And foundcell.Address <> firstAddress
        End If
    Next key
    
End Sub

数据是这样的：

从单元格D1开始的预期结果：

Sub test()
Dim r As Integer, rslt As Range, oData As Range, i As Integer

r = 6
Set rslt = Range("D1") 'change if needed
Set oData = Range("B2").Resize(r, 1) 'change if needed
rslt.Resize(1, r).Value = Application.Transpose(oData.Offset(0, -1).Value)

For i = 1 To Application.CountIf(Columns(1), oData.Offset(0, -1)(1, 1).Value)
    Set rslt = rslt.Offset(1, 0)
    rslt.Resize(1, r).Value = Application.Transpose(oData.Value)
    Set oData = oData.Offset(r, 0)
Next

End Sub

r变量用于B列中要转置的“数据行数”，在本例中为6
rslt变量是结果单元格。
oData变量是B列中的前r行数据。
它根据oData.offset（，-1）在结果单元格中创建“header”
然后，它循环与驻留在列1中的“行1”的计数一样多，并通过转置将oData值放入rslt。
请注意，如果例如单元格A2中的值为“row 1”，但单元格A8中的值为“row 1：”，则代码将失败，因为循环取决于列A中存在多少A2值。
例如，如果出现以下情况，它也会失败：range A2：A7的值是从“row 1”到“row 6”，但是在A8：A12中只有“row 1”到“row 5”---〉这将失败，因为代码假设数据总是有r行（在本例中为6行）。