Copy selected worksheets into a new workbook and leave selected information

[K0st4din]

Hello, everyone,
I ask for your cooperation because I have difficulty with one part in making a particular macro.
I've found many ways to copy multiple worksheets into a new workbook, but then I have to leave specific data in it.
Explanation:
I have a master workbook with 86 sheets, 28 of them already 6 years accumulates information for each month and the file becomes very large.
After choosing the desired 28 worksheets, I copy them into a new workbook and then by criteria in column A1 (here are the months and years), I start filtering which months to delete and which month to leave with all the information.
I try to make a pop up window in which if I want to leave for example 02/2018 everything else to be deleted, according to its length in each sheet and leave the information for the chosen month / year.
Once I've deleted everything, I have to navigate to the desired location on my computer and save the file.
I've made a macro, but it works only on manual criteria. I just do not know how to automate it.
I would be grateful for any assistance.
Greetings

Sub test()


    Sheets("City 1").Select
    ActiveWindow.ScrollWorkbookTabs Position:=xlLast
    Sheets(Array("City 1", "City 2", "City 3", "City 4", "City 5", "City 6", _
        "City 7", "City 8", "City 9", "City 10", "City 11", "City 12", "City 13", _
        "City 14", "City 15", "City 16", "City 17", "City 18", "City 19", "City 20", "City 21", _
        "City 22", "City 23", "City 24", "City 25")).Select
    Sheets("City 1").Activate
    Sheets(Array("City 26", "City 27", "City 28")).Select Replace:=False
    Sheets(Array("City 1", "City 2", "City 3", "City 4", "City 5", "City 6", _
        "City 7", "City 8", "City 9", "City 10", "City 11", "City 12", "City 13", _
        "City 14", "City 15", "City 16", "City 17", "City 18", "City 19", "City 20", "City 21", _
        "City 22", "City 23", "City 24", "City 28")).Select
    Sheets("City 28").Activate
    Sheets(Array("City 25", "City 26", "City 27")).Select Replace:=False
    Sheets(Array("City 1", "City 2", "City 3", "City 4", "City 5", "City 6", _
        "City 7", "City 8", "City 9", "City 10", "City 11", "City 12", "City 13", _
        "City 14", "City 15", "City 16", "City 17", "City 18", "City 19", "City 20", "City 21", _
        "City 22", "City 23", "City 24", "City 25", "City 26", "City 27", "City 28")). _
        Copy
    ActiveWindow.TabRatio = 0.942
     'Input box to select mounts to leave in new workbook
        NewName = InputBox("Please specify which month and year for example on 02/2018 you want to stay and all others to be deleted", "New Copy")
    Sheets("City 1").Select ' in my attempts, I chose to stay for me 02/2018 and delete all the rest.
    ActiveSheet.Range("$A$1:$P$25870").AutoFilter Field:=1, Operator:= _
        xlFilterValues, Criteria2:=Array(1, "1/1/2018", 0, "12/1/2017", 0, "12/1/2016", 0, _
        "12/1/2015", 0, "12/1/2014", 0, "12/1/2013")
    Rows("2:5").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=3
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$1:$P$322").AutoFilter Field:=1
    Range("A2").Select
    Sheets("City 2").Select
    ActiveSheet.Range("$A$1:$L$40469").AutoFilter Field:=1, Operator:= _
        xlFilterValues, Criteria2:=Array(1, "1/1/2018", 0, "12/1/2017", 0, "12/1/2016", 0, _
        "12/1/2015", 0, "12/1/2014", 0, "12/1/2013")
    ActiveWindow.SmallScroll Down:=-8
    Rows("2:7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$1:$L$259").AutoFilter Field:=1
    Range("A2").Select
    Sheets("City 3").Select
    ActiveSheet.Range("$A$1:$L$26383").AutoFilter Field:=1, Operator:= _
        xlFilterValues, Criteria2:=Array(1, "1/1/2018", 0, "12/1/2017", 0, "12/1/2016", 0, _
        "12/1/2015", 0, "12/1/2014", 0, "12/1/2013")
    Rows("2:6").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$1:$L$261").AutoFilter Field:=1
    Range("A2").Select
    Sheets("City 4").Select
    ActiveSheet.Range("$A$1:$L$24670").AutoFilter Field:=1, Operator:= _
        xlFilterValues, Criteria2:=Array(1, "1/1/2018", 0, "12/1/2017", 0, "12/1/2016", 0, _
        "12/1/2015", 0, "12/1/2014", 0, "12/1/2013")
    Rows("2:5").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=1
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$1:$L$211").AutoFilter Field:=1
    Range("A2").Select
    Sheets("City 5").Select
    ActiveSheet.Range("$A$1:$L$11121").AutoFilter Field:=1
    ActiveSheet.Range("$A$1:$L$11121").AutoFilter Field:=1, Operator:= _
        xlFilterValues, Criteria2:=Array(1, "1/1/2018", 0, "12/1/2017", 0, "12/1/2016", 0, _
        "12/1/2015", 0, "12/1/2014", 0, "12/1/2013")
    Rows("2:6").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$1:$L$40").AutoFilter Field:=1
    ' The macro continues until the last sheet in the new workbook
    Range("A2").Select
    ChDir "C:\my path\my path\Desktop"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\my path\my path\Desktop\I will put my desired name & ".xlsm", FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    ActiveWindow.Close
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("City 1").Select
End Sub

 

[K0st4din]

Hello,
I'm uploading two tables: the first is the base table where I add up every month.
In the second I wanted to leave only the month of 02.2018.
What I do (or at least I try to do) - after copying all the desired worksheets, I start deleting in every one of the other months and years until I'm left with 02.2018. The next month I will do the same, but then I will delete everything and leave the info for 03.2018 and so on.
If you have questions, I'm ready to answer, I just can not handle it.
Thank you in advance!
The files in dropbox
Base Workbook
Final results