CODEWITHSUNDEEP
exceltransposevba
LearningMonkey
LearningMonkey

Reputation: 11

Transpose sections of an Excel column

I have 8000 rows of data in column A.

I am trying to write code that would scan the rows and each time there's a cell formatted as bold, to determine a range that includes that cell and all cells in the subsequent rows until the next bold cell. This range should be copied to column B, tranposed.

Here's the code that I have so far:

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

Upvotes: 1

Views: 139

Answers (1)

A.S.H
A.S.H

Reputation: 29352

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

Upvotes: 1

Related Questions