Hi Mincus
A couple of tweaks to your code marked '@@@. I would also suggerst finding a method to remove Activate and Select from your method.
Sub Main()
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False '@@@ Prevent On-Open and other Event macros etc. from running
'THE MASTER FILE MUST BE SAVED IN THE FILE FOLDER
'ALONG WITH THE WORKBOOKS OF INTEREST
Dim MyTempWB As Workbook
Dim WS As Worksheet
'INFORMATION ABOUT YOUR FILE AND FOLDER
Dim MyWB As Workbook
Set MyWB = ActiveWorkbook
ThePath = MyWB.Path
MyWorkBookName = MyWB.Name
Sheet1.Cells(1, 1).Value = "ItemID's"
'LOOP THROUGH ALL FILES EXCEPT THE MASTER
vPath = ThePath & "\*.xls" '@@@ maybe *.xl* for more general application
Filename = Dir(vPath)
Do While Filename <> ""
If Filename = MyWorkBookName Then GoTo SkipThisFile
'OPEN NEXT FILE
Workbooks.Open (CStr(ThePath & "\" & Filename)), False '@@@ Prevent link upates
Set MyTempWB = ActiveWorkbook
'STEP THROUGH EACH SHEET IN THE FILE
With MyTempWB
For I = 1 To CInt(MyTempWB.Sheets.Count)
'SEARCH THE SHEET FOR VALUE ItemID AND XItemID
Set ItemIDColumn = MyTempWB.Sheets(I).Cells.Find("ItemID", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns)
If Not ItemIDColumn Is Nothing Then
FirstRow = MyTempWB.Sheets(I).Cells(ItemIDColumn.Row + 1, ItemIDColumn.Column).Row
LastRow = MyTempWB.Sheets(I).Cells(Rows.Count, ItemIDColumn.Column).End(xlUp).Row
Range(MyTempWB.Sheets(I).Cells(FirstRow, ItemIDColumn.Column), MyTempWB.Sheets(I).Cells(LastRow, ItemIDColumn.Column)).Copy
MyWB.Activate
Sheet1.Cells(Sheet1.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Select
ActiveSheet.Paste
MyTempWB.Activate
End If
Set XItemIDColumn = MyTempWB.Sheets(I).Cells.Find("XItemID", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns)
If Not XItemIDColumn Is Nothing Then
FirstRow = MyTempWB.Sheets(I).Cells(XItemIDColumn.Row + 1, XItemIDColumn.Column).Row
LastRow = MyTempWB.Sheets(I).Cells(Rows.Count, XItemIDColumn.Column).End(xlUp).Row
Range(MyTempWB.Sheets(I).Cells(FirstRow, XItemIDColumn.Column), MyTempWB.Sheets(I).Cells(LastRow, XItemIDColumn.Column)).Copy
MyWB.Activate
Sheet1.Cells(Sheet1.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Select
ActiveSheet.Paste
MyTempWB.Activate
End If
Next I
End With
'CLOSE THE FILE
MyTempWB.Close False '@@@ don't save changes
SkipThisFile:
Count = Count + 1
Filename = Dir()
Loop
'AT THIS POINT EVERYTHING HAS BEEN MOVED
'NOW LETS LOOP BACK THROUGH AND REMOVE YOUR N/A & BLANK VALUES
MyWB.Activate
For I = 1 To Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
If IsError(Sheet1.Cells(I, 1).Value) Then Sheet1.Cells(I, 1).EntireRow.Delete
If Sheet1.Cells(I, 1).Value = "" Then Sheet1.Cells(I, 1).EntireRow.Delete
If Sheet1.Cells(I, 1).Value = "#N/A" Then Sheet1.Cells(I, 1).EntireRow.Delete
Next I
Application.ScreenUpdating = True
Application.EnableEvents = True
On Error GoTo 0
MyWB.Save
End Sub