Question : VBA to Rearrange Excel Data and Apply Formatting

I’m looking for some VBA code that will rearrange the raw data in “SheetRaw” of my attached Excel file in the format you see on “SheetFinished”.  The code below should inspire some thought with you experts out there.  Any solutions to this are greatly appreciated! ;-)

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
Sub Rearrange()
    Dim Aarea As Range, Arange As Range
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set Arange = Range("A10", Range("A" & Rows.Count).End(xlUp))
    With Arange
        .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _
            Replace:=True, PageBreaks:=False, SummaryBelowData:=True
        .Offset(2, -1).SpecialCells(xlCellTypeConstants).Offset(, 1).ClearContents
        .Offset(, -1).EntireColumn.Delete
        .EntireColumn.RemoveSubtotal
    End With
    For Each Aarea In Arange.SpecialCells(xlCellTypeConstants).Areas
        With Aarea
            With .Cells(1, 1).Offset(-1)
                .Value = .Offset(1).Value
                .Font.Bold = True
                .EntireRow.Insert
            End With
            .ClearContents
        End With
    Next Aarea
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
Attachments:
 
Please see example file.
 

Answer : VBA to Rearrange Excel Data and Apply Formatting

try it again after correction
Random Solutions  
 
programming4us programming4us