Transfer Cells Based on Header

[Okcalla]

I am new to VBA and have hit a bit of a brick wall with my latest challenge. I have a report that gets generated based on the attributes of a block in Autocad. I need to take that information and transfer it to a spread sheet that is used by another department. Needless to say I am not allowed to alter that spreadsheet with my own code and because the report is generated new each time, I also cannot alter the original information as that would be fruitless. So, my only option is to create my own, 3rd sheet, that opens each file and matches the headers in the original 2 then pastes the information from the report that has a corresponding header.

I have code that allows me to set the Source file as well as the Target file using the filedialog. This method will allow me to open both files by the variable I have set. That is where my success has stopped. I can't figure out how to tell the code which sheet in each file to look at.

I have searched all of this extensively, however most code involves only 2 sheets not the 3 sheet method I have to use. This code is an amalgamation of others I have found mixed with some of my own. This code is started when the user presses a button I have placed on the excel frontend. Any help is appreciated.

Option Explicit
'Function to check if worksheets entered in input boxes exist
Public Function wsExists(ByVal WorksheetName As String) As Boolean


On Error Resume Next
wsExists = (Sheets(WorksheetName).Name <> "")
On Error GoTo 0 ' now it will error on further errors


End Function
Sub Cell_Transfer()


Dim Source As String
Dim Target As String
Dim strUserName As String


Dim i As Integer
Dim a(1 To 1) As Integer
Dim b(1 To 1) As Integer
Dim lkup As String
Dim dummy As Variant
Dim SheetName As Variant 'sheet name from array to test
Dim ArrayName As Variant 'Array
Dim lkr As Range
Dim ahd As Variant
Dim chd As Variant
Dim cn As Long
Dim ws As Worksheet
Dim lkr1 As Range
Dim ahd1 As Variant
Dim chd1 As Variant
Dim cn1 As Long
Dim ws1 As Worksheet






strUserName = Environ("username")


Application.ScreenUpdating = False 'Speeds up the routine by not updating the screen.
'IMPORTANT, remember to turn screen updating back on before the routine ends




'***** ENTERING WORKBOOK NAMES *****


'Get the name of the worksheet to be copied from
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = "C:\Users\" & strUserName & "\Desktop"
.Title = "Choose Source File"
.AllowMultiSelect = False
.Filters.Add "spreadsheets", "*.xlsx", 1


If .Show = True Then
Source = Dir(.SelectedItems(1))
   
     End If
    
'Get the name of the workbook to pasted into
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = "C:\Users\" & strUserName & "\Desktop"
.Title = "Choose Target File"
.AllowMultiSelect = False
If .Show = True Then
Target = Dir(.SelectedItems(1))
    
    
    End If
 End With
    






'Telling the macro to search the top row for the column heading in both sheets
    a(i) = Sheets(Sheet1).Rows(1).Find("STREETNUMBER", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False).Column
    b(i) = Sheets(Sheet1).Rows(1).Find("STREETNUMBER", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False).Column




'Copy Lookup Column
     Sheets(Source).Select
     Range(Cells(2, a(i)), Cells(Cells(Rows.Count, a(i)).End(xlUp).Row, a(i))).Copy ' Only copies from row 2
       
        
'Paste Lookup Column
    Sheets(Target).Activate
        With Cells(2, b(i)) ' Pastes from row 2 down
          .PasteSpecial Paste:=xlPasteValues
        End With
        
    Application.CutCopyMode = False 'Clears the clipboard






 
On Error GoTo 0 ' resets error settings to break on errors
        
'We now need to turn exact cell content match off, VERY IMPORTANT DO NOT LEAVE THIS OUT
    Set dummy = Worksheets(1).Cells.Find(What:=" ", after:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    
    Application.ScreenUpdating = True  'Turn screen updating back on


End With
End Sub