Hello SamT,
I think you can understand.
All other macros work perfectly without any errors, but the macro can not do it.
I need your help to make my explanations above macro.
I found many examples that show how one workbook to copy the first sheet and keep in a new workbook, but I could not find how the criteria in a cell and then check to keep the second sheet's (Sheet2 and Sheet3).
Okay, I found this macro, which is roughly good, but you'll have to change it after you save the new file name can be set to open a folder on the desktop and automatically find the folder with the name of the city (taken from cell C5) and save it there.
Option Explicit
Sub TwoSheetsAndYourOut()
Dim NewName As String
Dim nm As Name
Dim ws As Worksheet
If MsgBox("Copy specific sheets to a new workbook" & vbCr & _
"New sheets will be pasted as values, named ranges removed" _
, vbYesNo, "NewCopy") = vbNo Then Exit Sub
With Application
.ScreenUpdating = False
' Copy specific sheets
' *SET THE SHEET NAMES TO COPY BELOW*
' Array("Sheet Name", "Another sheet name", "And Another"))
' Sheet names go inside quotes, seperated by commas
On Error GoTo ErrCatcher
Sheets(Array("Sheet2", "Sheet3")).Copy
On Error GoTo 0
' Paste sheets as values
' Remove External Links, Hperlinks and hard-code formulas
' Make sure A1 is selected on all sheets
For Each ws In ActiveWorkbook.Worksheets
ws.Cells.Copy
ws.[A1].PasteSpecial Paste:=xlValues
ws.Cells.Hyperlinks.Delete
Application.CutCopyMode = False
Cells(1, 1).Select
ws.Activate
Next ws
Cells(1, 1).Select
' Remove named ranges
For Each nm In ActiveWorkbook.Names
nm.Delete
Next nm
' Input box to name new file
NewName = InputBox("Please Specify the name of your new workbook", "New Copy")
' Save it with the NewName and in the same directory as original.
' I am referring here to make a change, ie once
' I set my path to desktop - how then to automatically find the name of the city and there to save?
ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls" 'perhaps to use it or something else -> strName = Range("C5") ActiveWorkbook.SaveAs Filename:= ThisWorkbook.Path & "\" & strName
ActiveWorkbook.Close SaveChanges:=False
.ScreenUpdating = True
End With
Exit Sub
ErrCatcher:
MsgBox "Specified sheets do not exist within this workbook"
End Sub