移調部分

Question

我在A列

我想編寫的代碼，將掃描的行和每次8000行數據，還有爲加粗格式的單元格，以確定包括一系列該單元格和後續行中的所有單元格直到下一個粗體單元格。這個範圍應該被複制到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