Transponieren Abschnitte einer Excel-Spalte

Question

Ich habe 8000 Zeilen von Daten in Spalte A

Ich versuche, Code zu schreiben, um die Zeilen und jedes Mal scannen würde es eine Zelle als fett formatiert ist, um einen Bereich zu bestimmen, der folgendes beinhaltet diese Zelle und alle Zellen in den nachfolgenden Zeilen bis zur nächsten fettgedruckten Zelle. Dieser Bereich sollte in die transponierte Spalte B kopiert werden.

Hier ist der Code, den ich bisher habe:

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