Транспонирование секции столбца Excel

Question

У меня есть 8000 строк данных в столбце A.

Я пытаюсь написать код, который будет сканировать строки и каждый раз, когда есть ячейка отформатирована как полужирный, чтобы определить диапазон, который включает в себя эту ячейку и все ячейки в последующих строках до следующей жирной ячейки. Этот диапазон должен быть скопирован в колонку B, преобразован.

Вот код, который я до сих пор:

Sub Sorting() 
    Application.ScreenUpdating = False 
    last_row = ActiveSheet.Range("A" & Cells.Rows.Count).End(xlUp).Row 
    y = 1 

    For i = 1 To LastRow 
     If Range("A" & i).Font.Bold = True Then 
      Range("A" & i).Copy Range("A" & i + 9) 
      Range("B" & y).PasteSpecial Transpose:=True 
      y = y + 1 
      x = i 
     Else 
      Range("A" & x).Copy Range("B" & i) 
     End If 
    Next i 
    Application.ScreenUpdating = True 
End Sub 

Answer 1

Sub doIt() 
    Dim a1 As Range: Set a1 = Range("A1") 
    Dim a2 As Range: Set a2 = a1.Offset(1) 
    Dim b As Range: Set b = Range("B1") 
    Do Until Intersect(a2, ActiveSheet.UsedRange) Is Nothing 
     If a2.Font.Bold Then 
      b.Resize(, a2.row - a1.row) = Application.Transpose(Range(a1, a2.Offset(-1))) 
      Set a1 = a2: Set a2 = a1.Offset(1): Set b = b.Offset(1) 
     Else 
      Set a2 = a2.Offset(1) 
     End If 
    Loop 
    b.Resize(, a2.row - a1.row) = Application.Transpose(Range(a1, a2.Offset(-1))) 
End Sub