Data Arrangement

Kindly advise,

Attached excel sheet for your reference. Thanks in advance.

The blue colour heading's data downloaded from intranet.
This is the raw data
The information run with very details which is not required. No filter to select the required information



The Green colour heading's data arranged manually i.e., copy & paste the data.

Solution:
Are there any way we can simplify without mannual copy & paste the data.
Chances are there copying will go error and Total amount does not match.

This should work for the data provided.

Sub test()
    Dim myAreas As Areas, i As Long
    Application.ScreenUpdating = False
    With Sheets("data")
        With .Range("a2", .Range("d" & Rows.Count).End(xlUp)(0))
            .Value = Application.Trim(.Value)
            Set myAreas = .Columns(1).SpecialCells(4).Areas
        End With
        .Rows(2).Resize(, 8).Copy .Range("j2")
        For i = 1 To myAreas.Count
            myAreas(i)(0).Resize(, 8).Copy .Range("j" & i + 2)
            With myAreas(i).Offset(, 3).SpecialCells(2)
                .Areas(.Areas.Count).Resize(, 5).Copy .Parent.Range("m" & i + 2)
            End With
        Next
        Range("d" & Rows.Count).End(xlUp).EntireRow.Resize(, 8).Copy
        With .Range("j" & i + 2)
            .PasteSpecial
            .PasteSpecial xlValues
        End With
    End With
    Application.ScreenUpdating = True
End Sub

Hi Jindon,

Thanks for you help.

I need macro to coy Col-9 & Col-10 data and pasted to after Col-8

Change to

Sub test()
    Dim myAreas As Areas, i As Long, cols As Long
    Application.ScreenUpdating = False
    With Sheets("data")
        With .Range("a2", .Range("d" & Rows.Count).End(xlUp)(0))
            cols = .CurrentRegion.Columns.Count
            .Value = Application.Trim(.Value)
            Set myAreas = .Columns(1).SpecialCells(4).Areas
        End With
        .Rows(2).Resize(, cols).Copy .Cells(2, cols + 2)
        For i = 1 To myAreas.Count
            myAreas(i)(0).Resize(, cols).Copy .Cells(i + 2, cols + 2)
            With myAreas(i).Offset(, 3).SpecialCells(2)
                .Areas(.Areas.Count).Resize(, 8).Copy .Parent.Cells(i + 2, cols + 5)
            End With
        Next
        Range("d" & Rows.Count).End(xlUp).EntireRow.Resize(, cols).Copy
        With .Cells(i + 2, cols + 2)
            .PasteSpecial
            .PasteSpecial xlValues
        End With
    End With
    Application.ScreenUpdating = True
End Sub