Excel VBA: Code Breaking During Find Method

Question

I have created (read: failed miserably at) an Excel macro to automate copying columns, based on the header, from one workbook to another. So far, everything works until I get to the Find method. The error that is being thrown reads "Type mismatch."

In my example, two workbooks must be open for the macro to run. Note, the source workbook has the columns headers starting on row 2. I would like to select the column based on header but only copy the cells below the header (e.g. the data).

Can anyone provide insight into what I'm doing wrong? Thanks!

Public Sub Autofill_Tracker()
    Dim sourceBook As Workbook
    Dim targetBook As Workbook
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet

' Check to make sure only 2 workbooks are open
    If Workbooks.Count <> 2 Then
        MsgBox "There must be exactly 2 workbooks open to run the macro!", vbCritical + vbOKOnly, "Copy Columns From Source To Target"
        Exit Sub
    End If

' Set the source and target workbooks
    Set targetBook = ActiveWorkbook
   If Workbooks(1).Name = targetBook.Name Then
        Set sourceBook = Workbooks(2)
    Else
        Set sourceBook = Workbooks(1)
    End If

' Set up the sheets
    Set sourceSheet = sourceBook.ActiveSheet
    Set targetSheet = targetBook.ActiveSheet

' Find headings and copy the columns
    sourceSheet.Activate
    Rows("2:2").Find(What:="Device ID", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    c = ActiveCell.Column
    sourceSheet.Columns(c).Copy
    targetSheet.Activate
    targetSheet.Select
    targetSheet.Range("A12:A112").Select
    targetSheet.Paste Link:=True

End Sub

I edited this to include my original code that worked like a charm, but very prone to errors. If the columns of the source workbook happened to be out of order (very common), then they would not get pasted into the correct order in target worksheet. Hence, why I'm am trying to adjust the macro so that is copies and pastes based on column header. That way, the order of the columns in the source workbook is moot.

'device id'
sourceSheet.Range("H3:H103").Copy
targetSheet.Range("A12:A112").Select
targetSheet.Paste Link:=True

'serial no'
sourceSheet.Range("L3:L103").Copy
targetSheet.Range("B12:B112").Select
targetSheet.Paste Link:=True

'asset id'
sourceSheet.Range("G3:G103").Copy
targetSheet.Range("C12:C112").Select
targetSheet.Paste Link:=True

'manufacturer'
sourceSheet.Range("D3:D103").Copy
targetSheet.Range("D12:D112").Select
targetSheet.Paste Link:=True

'model'
sourceSheet.Range("I3:I103").Copy
targetSheet.Range("E12:E112").Select
targetSheet.Paste Link:=True

Answer 1

You can do something like this. I'm not sure what you are trying to copy so you may have to adjust that.

Public Sub Autofill_Tracker()

Dim sourceBook As Workbook
Dim targetBook As Workbook
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim r As Range, v As Variant, i As Long

If Workbooks.Count <> 2 Then
    MsgBox "There must be exactly 2 workbooks open to run the macro!", vbCritical + vbOKOnly, "Copy Columns From Source To Target"
    Exit Sub
End If

Set targetBook = ActiveWorkbook
If Workbooks(1).Name = targetBook.Name Then
    Set sourceBook = Workbooks(2)
Else
    Set sourceBook = Workbooks(1)
End If

Set sourceSheet = sourceBook.ActiveSheet
Set targetSheet = targetBook.ActiveSheet
targetSheet.Activate

v = Array("Device ID", "Serial No", "Asset ID", "Manufacturer", "Model") 'Amend to suit

For i = LBound(v) To UBound(v)
    Set r = sourceSheet.Rows("2:2").Find(What:=v(i), LookIn:=xlFormulas, _
                                         MatchCase:=False, SearchFormat:=False)
    If Not r Is Nothing Then
        r.Offset(1).Resize(101).Copy
        Range("A12").Offset(, i).Select
        ActiveSheet.Paste link:=True
    End If
Next i

End Sub