How to sort rows in sheet1 by using the predefined order of locations specified in sheet4

Hi All,

With below macro code I am able to create the report as shown in Sheet1.
Now I would like to continue the code with some more modifications,
All I want to do is - I would like to group the locations & insert few rows in sheet1 based on the order criteria shown in Sheet4 (Order shown in sheet1 is fixed).
So my final report should be present as shown in Sheet “Summary”.

Please help me with modifying the code.

Thank you in advance.

Private Sub CommandButton1_Click()

Dim PvtTbl As PivotTable
Dim PvtTblCache As PivotCache
Dim ws As Worksheet, wsPvtTbl As Worksheet
Dim rng As Range, Pvtrng As Range, Pvtcell As Range, Mrng As Range
Dim lr As Long, Pvtlr As Long
Application.ScreenUpdating = False
Set ws = Sheets("Sheet3")
lr = ws.Cells(Rows.Count, 2).End(xlUp).Row
Set rng = ws.Range("A1:E" & lr)
Set wsPvtTbl = Sheets("Sheet1")
'wsPvtTbl.Cells.Clear
For Each PvtTbl In wsPvtTbl.PivotTables
    'PvtTbl.TableRange2.Clear
Next PvtTbl
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rng, _
Version:=xlPivotTableVersion12).CreatePivotTable tabledestination:=wsPvtTbl.Range("D6"), _
TableName:="PivotTable1", defaultversion:=xlPivotTableVersion12

Set PvtTbl = wsPvtTbl.PivotTables("PivotTable1")
wsPvtTbl.Select
    With PvtTbl.PivotFields("Invoiced By")
        .Orientation = xlRowField
        .Position = 1
        .Subtotals(1) = False
    End With
    
    With PvtTbl.PivotFields("Gross Profit")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
    End With
    With PvtTbl.PivotFields("Gross Profit")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 2
    End With
    
    With PvtTbl.PivotFields("MTD Gross")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 3
    End With
    
        With PvtTbl
        .RowAxisLayout xlTabularRow
    End With
Pvtlr = wsPvtTbl.Cells(Rows.Count, 1).End(xlUp).Row

With Range("D7:G7")
    .Interior.ColorIndex = 1
    .Font.ColorIndex = 2
    .Font.Size = 12
    .Font.Bold = True
End With
'With Range("D" & Pvtlr & ":D" & Pvtlr)
 '   .Interior.ColorIndex = 2
  '  .Font.ColorIndex = 2
'End With

wsPvtTbl.Columns.AutoFit
Range("D1").Select
Application.ScreenUpdating = True

    With ActiveSheet.UsedRange
        .Cells.Copy
        .Cells.PasteSpecial xlPasteValues
        .Cells(1).Select
    End With
    
    Rows(5).Delete
    
    Application.CutCopyMode = False

MsgBox "Report has been created successfully."


End Sub

Please help me with code for above