Excel VBA: взлом кода при поиске

Question

Я создал (читай: с треском провалился) макрос Excel для автоматизации копирования столбцов на основе заголовка из одной рабочей книги в другую.Пока все работает, пока я не доберусь до метода Find.Выбрасываемая ошибка гласит: «Несоответствие типов».

В моем примере для запуска макроса должны быть открыты две рабочие книги.Обратите внимание, что в исходной книге заголовки столбцов начинаются со строки 2. Я хотел бы выбрать столбец на основе заголовка, но скопировать только ячейки ниже заголовка (например, данные).

Может кто-нибудь дать представление о том, чтоЯ делаю не так?Спасибо!

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

Я отредактировал это, чтобы включить мой оригинальный код, который работал как брелок, но очень подвержен ошибкам.Если столбцы исходной рабочей книги оказались не в порядке (очень часто), то они не будут вставлены в правильный порядок в целевой рабочей таблице.Поэтому я пытаюсь настроить макрос так, чтобы он копировал и вставлял на основе заголовка столбца.Таким образом, порядок столбцов в исходной рабочей книге спорный.

'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

Вы можете сделать что-то вроде этого.Я не уверен, что вы пытаетесь скопировать, поэтому вам, возможно, придется настроить это.

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