Order list with a Macro

Hi everyone,

I have following:

Sub CopyRangeITOFF() Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Sheets("IT").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Sheets("IT").Sort.SortFields.Clear
Sheets("IT").Sort.SortFields.Add Key:=Range("R1:R" & LastRow), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
Sheets("IT").Sort.SortFields.Add Key:=Range("S1:S" & LastRow), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With Sheets("IT").Sort
.SetRange Range("A1:AR" & LastRow)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=2, Criteria1:="Y"
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=3, Criteria1:="1"
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=6, Criteria1:=">=" & CLng(Date)
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=10, Criteria1:=Array( _
"Trentino-Alto Adige", "Tuscany", "Emilia-Romagna", "Veneto", "Latium", "Lombardy"), Operator:=xlFilterValues
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=8, Criteria1:="Hotel"
Sheets("IT").Range("A2:AR" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("IT GROUPS").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
If Sheets("IT").AutoFilterMode = True Then Sheets("IT").AutoFilterMode = False
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=6, Criteria1:=">=" & CLng(Date)
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=10, Criteria1:=Array( _
"Sicily", "Aosta Valley", "Campania", "Liguria", "Basilicata", "Marches"), Operator:=xlFilterValues
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=8, Criteria1:="Hotel"
Sheets("IT").Range("A2:AR" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("IT GROUPS").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
If Sheets("IT").AutoFilterMode = True Then Sheets("IT").AutoFilterMode = False
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=6, Criteria1:=">=" & CLng(Date)
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=10, Criteria1:=Array( _
"Piedmont", "Apulia", "Umbria", "Abruzzo", "Sardinia", "Calabria"), Operator:=xlFilterValues
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=8, Criteria1:="Hotel"
Sheets("IT").Range("A2:AR" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("IT GROUPS").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
If Sheets("IT").AutoFilterMode = True Then Sheets("IT").AutoFilterMode = False
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=6, Criteria1:=">=" & CLng(Date)
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=8, Criteria1:="Package"
Sheets("IT").Range("A2:AR" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("IT GROUPS").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
If Sheets("IT").AutoFilterMode = True Then Sheets("IT").AutoFilterMode = False
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=2, Criteria1:="Y"
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=3, Criteria1:="1"
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=6, Criteria1:=">=" & CLng(Date)
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=7, Criteria1:=Array( _
"LONG_HAUL", "MIDDLE_HAUL"), Operator:=xlFilterValues
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=8, Criteria1:="Hotel"
Sheets("IT").Range("A2:AR" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("IT GROUPS").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
If Sheets("IT").AutoFilterMode = True Then Sheets("IT").AutoFilterMode = False
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=6, Criteria1:=">=" & CLng(Date)
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=8, Criteria1:="HOTEL"
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=7, Criteria1:="EUROPE"
Sheets("IT").Range("A1:AR" & LastRow).AutoFilter Field:=9, Criteria1:="<>Italy"
Sheets("IT").Range("A2:AR" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("IT GROUPS").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
If Sheets("IT").AutoFilterMode = True Then Sheets("IT").AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

On top of each group that we "pasted" on the new sheet, I need to add 2 rows, the first one should be empty and then the second one of each group as following:

"DOM1" for the first group, "DOM2" for the second group, "DOM3" for the third group, "PKG" for the fourth group, "INT" for the fifth group and "EU" for the sixth.
Kindly check the following file. Sheet named "IT GROUPS FINAL" is what I am looking for.

Then, I would like to have another Macro (not sure if this is possible to be honest). Please see the tab named "RANKING".
I would like to create a new sheet named "RANKING".
- Row 2 header
- A3:B38 is always looping till row 1010
- I would like Macro to extract the row of "IT GROUPS FINAL" of each category that is matching with the category in column B in ranking.
To be clearer: the 1st DOM1 in Column B of sheet "RANKING" needs to be the 1st row of group DOM1 in sheet "IT GROUP FINAL", the 1st PKG in Column B of sheet "RANKING" needs to be the 1st row of group PKG in sheet "IT GROUP FINAL", etc., etc.

This as I would like the final result

https://www.dropbox.com/s/zoh2knza46...N%29.xlsx?dl=0

Not sure if it is possible. Anyone able to help me please?

P.S
I have just edited the message to be, I hope, more precise.
The code for adding the rows needs to be added between the rows I have underscored on my above quote.

Thank you in advance