loop through files find columns and copy/paste them as columns in master workbook

Hi everyone!

Here is what im attempting to do in vba:

select folder with files
for each workbook in the folder
for each worksheet
if column = "Field" or "Table" with title background filled with orange
copy and paste into master workbook as column
for each copied column paste with header containing column name + workbook name + worksheet name
close all workbooks except master
save master

I've found something similar to what I need, but it will not work properly - the code will only copy first instance of column from first worksheet, so only one column named "Field" will be copied isntead of every instance. I need to get all columns named Field and Table from each worksheet of each workbook and store them in one worksheet as separate columns side by side with headers containing info of their origin:

Sub Main()
On Error Resume Next
Application.ScreenUpdating = False
'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 = "Field"
'LOOP THROUGH ALL FILES EXCEPT THE MASTER
vPath = ThePath & "\*.xls"
Filename = Dir(vPath)
Do While Filename <> ""
If Filename = MyWorkBookName Then GoTo SkipThisFile
'OPEN NEXT FILE
Workbooks.Open (CStr(ThePath & "" & Filename))
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
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
On Error GoTo 0
MyWB.Save
End Sub

Im frustrated beyond belief, as it seems to be so close to a solution and yet so far away.

Thank you in advance.

Just wondering, did it work?