Breakdown packing list in VBA

[mehidy1437]

Hi, I have many packing lists, which I need to break down.

Here I have attached the file, I have two sheets named "PKL" & "Result",
PKL sheet contains the packing details, I need vb to add a result sheet & show me the result as per my "Result" sheet format.
The Result sheet will generate from PKL sheet.

How can I do the job in VB, kindly help me with this?
Example file

 

[mehidy1437]

This is how I'm doing to get the result sheet output.

Option Explicit

Sub SummeryPAKL()

Application.ScreenUpdating = False

Dim ActvSheetNumb As Integer
Dim AddedSheetNumb As Integer
ActvSheetNumb = ActiveSheet.Index
AddedSheetNumb = ActvSheetNumb + 1

Dim StyleAreaSt As Range
Dim StyleIdStrt  As String
Dim StyleStarts  As String
Dim StyleStartsRowNum As Integer

'select a1-z150 copy , paste as valu and unmerge
    Range("A1:z150").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.UnMerge

Set StyleAreaSt = Range("A:A").Find(What:=("Style"), LookIn:=xlValues, lookat:=xlWhole)
StyleIdStrt = StyleAreaSt.Address(0, 0)
StyleStarts = StyleAreaSt.Offset(2, 0).Address(0, 0)
StyleStartsRowNum = Range(StyleAreaSt.Offset(2, 0).Address).row
    
    Dim StyleAreaEnd As Range
    Dim StyleIdEnd  As String
    Dim StyleEnd  As String
    Dim StyleEndRowNum As Integer

    Set StyleAreaEnd = Range("A:A").Find(What:=("Total="), LookIn:=xlValues, lookat:=xlWhole)
    StyleIdEnd = StyleAreaEnd.Address(0, 0)
    StyleEnd = StyleAreaEnd.Offset(-1, 0).Address(0, 0)
    StyleEndRowNum = Range(StyleAreaEnd.Offset(-1, 0).Address).row
    
            Dim h1 As Worksheet
            Set h1 = ActiveSheet
            Dim h2 As Worksheet
            Set h2 = ActiveWorkbook.Sheets.Add(Type:=xlWorksheet, After:=Application.ActiveSheet)
            
            Dim row As Long
            Dim col As Long
            Dim x As Long
        '-------------------------------------
            ActiveSheet.Select
            x = 2
            
            'Headers Sheet2
            Sheets(AddedSheetNumb).Cells(1, 1).Value = "CARTON NR" 'ctn Srl no
            Sheets(AddedSheetNumb).Cells(1, 2).Value = "ORDER YEAR"
            Sheets(AddedSheetNumb).Cells(1, 3).Value = "ORDER NR." 'order no
            Sheets(AddedSheetNumb).Cells(1, 4).Value = "PRODUCT" 'style
            Sheets(AddedSheetNumb).Cells(1, 5).Value = "COLOR"
            Sheets(AddedSheetNumb).Cells(1, 6).Value = "SIZE"
            Sheets(AddedSheetNumb).Cells(1, 7).Value = "QTY"
            Sheets(AddedSheetNumb).Cells(1, 8).Value = "Ref"
            Sheets(AddedSheetNumb).Cells(1, 9).Value = "Ctn Qty"
            Sheets(AddedSheetNumb).Cells(1, 10).Value = "Total Qty"
            Sheets(AddedSheetNumb).Cells(1, 11).Value = "Ctn No"
          
               For row = StyleStartsRowNum To StyleEndRowNum
                   For col = 8 To 19 ' sizes column
                    Sheets(AddedSheetNumb).Cells(x, 1).Value = "" 'blank
                    Sheets(AddedSheetNumb).Cells(x, 2).Value = "2020" 'order year
                    Sheets(AddedSheetNumb).Cells(x, 3).Value = Sheets(ActvSheetNumb).Cells(row, 2).Value 'order no
                    Sheets(AddedSheetNumb).Cells(x, 4).Value = Sheets(ActvSheetNumb).Cells(row, 1).Value 'style
                    Sheets(AddedSheetNumb).Cells(x, 5).Value = Sheets(ActvSheetNumb).Cells(row, 7).Value 'color
                    Sheets(AddedSheetNumb).Cells(x, 6).Value = Sheets(ActvSheetNumb).Cells(9, col).Value 'sizes from pkl sheet
                    Sheets(AddedSheetNumb).Cells(x, 7).Value = Sheets(ActvSheetNumb).Cells(row, col).Value 'size wise qty
                    
                    Sheets(AddedSheetNumb).Cells(x, 8).Value = Sheets(ActvSheetNumb).Cells(row, 3).Value ' ref no
                    Sheets(AddedSheetNumb).Cells(x, 9).Value = Sheets(ActvSheetNumb).Cells(row, 20).Value 'ctn qty
                    Sheets(AddedSheetNumb).Cells(x, 10).Value = Sheets(AddedSheetNumb).Cells(x, 7).Value * Sheets(AddedSheetNumb).Cells(x, 9).Value
                    Sheets(AddedSheetNumb).Cells(x, 11).Value = Sheets(ActvSheetNumb).Cells(row, 4).Value 'carton no d col
                    
                    x = x + 1
                Next
            Next
 '-------------------------------------
Sheets(AddedSheetNumb).Columns("g:g").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'-------------------------------------
            Sheets(AddedSheetNumb).Cells(1, 13).Value = "CARTON NR"
            Sheets(AddedSheetNumb).Cells(1, 14).Value = "ORDER YEAR"
            Sheets(AddedSheetNumb).Cells(1, 15).Value = "ORDER NR." 'order no
            Sheets(AddedSheetNumb).Cells(1, 16).Value = "PRODUCT" 'style
            Sheets(AddedSheetNumb).Cells(1, 17).Value = "COLOR"
            Sheets(AddedSheetNumb).Cells(1, 18).Value = "SIZE"
            Sheets(AddedSheetNumb).Cells(1, 19).Value = "QTY"
            Sheets(AddedSheetNumb).Cells(1, 20).Value = "Ref"
            Sheets(AddedSheetNumb).Cells(1, 21).Value = "Ctn Qty"
            Sheets(AddedSheetNumb).Cells(1, 22).Value = "Total Qty"
            Sheets(AddedSheetNumb).Cells(1, 23).Value = "Ctn No"

' TO COPY THE ROW NTH TIME BASED ON CELL VALUE
Dim rng As Range
                              
    For Each rng In Range("I2", Range("I" & Rows.Count).End(xlUp)) 'CELL VALUE TO PASTE REPEAT ROW
       Cells(Rows.Count, 14).End(xlUp)(2).Resize(rng.Value, 11) = rng.Offset(, -7).Resize(1, 11).Value
       'S/B 13, but 13 is empty that's why put 14
       'put 11 coz data column is 1 to 11
       'put -7 coz, from column k to B, coz a is empty
       'last 1,11 is column range a-k
       Next rng
 '-------------------------------------
'FOR CTN SERAIAL NO formula at T3 =IF(Q3>1,T2+1,S3)
 Range("X1").Value = "Ctn SRL"
 Range("X2").Value = 1
 Range("X3").Formula = "=IF(U3>1,X2+1,W3)"
 'U3-CTN QTY FM PKL, X2-CTN SRL VALUE 1, W3-CTN NO FM PKL LIST
 '-------------------------------------
 'FORMULA TO COPY DOWN & COPY X COL TO M COL
 Range("X3:X" & Range("W" & Rows.Count).End(xlUp).row).FillDown
 'copy x col to m col as value
 Range("M2:M" & Range("W" & Rows.Count).End(xlUp).row).Value = _
 Range("X2:X" & Range("W" & Rows.Count).End(xlUp).row).Value
 'custom formating col M as D1 D2 D3
 Range("M2:M" & Range("W" & Rows.Count).End(xlUp).row).NumberFormat = """D""General"

 '-------------------------------------
 'delete col
 'Range("D:E, H:H, J:K").EntireColumn.Delete
 'Range("A:L, T:X").EntireColumn.Delete
  Range("A:L").EntireColumn.Delete
 
 '-------------------------------------
 
Application.ScreenUpdating = True

End Sub