Need some help to merge 2 bas files into one and run

[dippncope]

Hello I am a scripting novice and need some help please. I have a bunch of bas files that scan a spreadsheet looking for a city name. If it finds the name it creates a new work sheet with the name of the city and copies the entire row into the new sheet. The workbook contains about 100 cities and the list changes daily. I only need two cities out of the list. What I would like to do is combine the two that I have into one. Here are the two that I have.
Thank you.
File one
________________________________________________________
Attribute VB_Name = "Trevose"
Sub Extract_Data()
'this macro assumes that your first row of data is a header row.
'will copy a row from one worksheet, to another blank workbook
'IF there is TREVOSE in column G
'Variables used by the macro
Application.ScreenUpdating = False
Dim FilterCriteria
Dim CurrentFileName As String
Dim NewFileName As String

Set a = ActiveSheet
'Select Range
'(note you can change this to meet your requirements)
Range("A1:AS4000").Select
'Apply Autofilter
Selection.AutoFilter
FilterCriteria = "TREVOSE"
'NOTE - this filter is on column G (field:=7), to change
'to a different column you need to change the field number
Selection.AutoFilter field:=7, Criteria1:=FilterCriteria
'Select the visible cells (the filtered data)
Selection.SpecialCells(xlCellTypeVisible).Select
'Copy the cells
Selection.Copy
'Open a new file
'Workbooks.Add Template:="Workbook"
'Get this file's name
'NewFileName = ActiveWorkbook.Name
Sheets.Add().Name = "TREVOSE"
Set b = ActiveSheet
'Make sure you are in cell A1
Range("A1").Select
'Paste the copied cells
ActiveSheet.Paste
Range("A1").Select 'unselect everything
'Clear the clipboard contents
Application.CutCopyMode = False
'Go back to the original file
'Workbooks(CurrentFileName).Activate
a.Select
Selection.AutoFilter field:=7, Criteria1:=FilterCriteria
Selection.SpecialCells(xlCellTypeVisible).Select
'Clear the autofilter
'Selection.AutoFilter field:=1
'Take the Autofilter off
Selection.AutoFilter
'Go to A1
'Range("A1").Select
Application.ScreenUpdating = True
End
End Sub
_____________________________________________________
Flie two
____________________________
Attribute VB_Name = "KOP"
Sub Extract_Data()
'this macro assumes that your first row of data is a header row.
'will copy a row from one worksheet, to another blank workbook
'IF there is KING OF PRUSSIA in column G
'Variables used by the macro
Application.ScreenUpdating = False
Dim FilterCriteria
Dim CurrentFileName As String
Dim NewFileName As String

Set a = ActiveSheet
'Select Range
'(note you can change this to meet your requirements)
Range("A1:AS4000").Select
'Apply Autofilter
Selection.AutoFilter
FilterCriteria = "KING OF PRUSSIA"
'NOTE - this filter is on column G (field:=7), to change
'to a different column you need to change the field number
Selection.AutoFilter field:=7, Criteria1:=FilterCriteria
'Select the visible cells (the filtered data)
Selection.SpecialCells(xlCellTypeVisible).Select
'Copy the cells
Selection.Copy
'Open a new file
'Workbooks.Add Template:="Workbook"
'Get this file's name
'NewFileName = ActiveWorkbook.Name
Sheets.Add().Name = "KING OF PRUSSIA"
Set b = ActiveSheet
'Make sure you are in cell A1
Range("A1").Select
'Paste the copied cells
ActiveSheet.Paste
Range("A1").Select 'unselect everything
'Clear the clipboard contents
Application.CutCopyMode = False
'Go back to the original file
'Workbooks(CurrentFileName).Activate
a.Select
Selection.AutoFilter field:=7, Criteria1:=FilterCriteria
Selection.SpecialCells(xlCellTypeVisible).Select
'Clear the autofilter
'Selection.AutoFilter field:=1
'Take the Autofilter off
Selection.AutoFilter
'Go to A1
'Range("A1").Select
Application.ScreenUpdating = True
End
End Sub
_______________________________________

 

[PHV]

What about something like this ?
Selection.AutoFilter field:=7, Criteria1:="TREVOSE", Operator:=xlOr, Criteria2:="KING OF PRUSSIA"

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[dippncope]

I will try. Thank you.