Excel VBA:查找方法期间的代码中断

我已经创建了read:在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

---

你可以这样做。我不确定你想复制什么，所以你可能需要调整

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

---

很多事情。如果未找到该值，则在激活不存在的内容时会出错；如果活动单元格不在第2行，则会出错，并且无法将整列复制到列A12:A112的一部分。你想在那里做什么？我的最终目标相当于。。。。1.打开两本工作手册。2.在工作簿2中，用鼠标选择列中标记为Device ID…的所有数据，不包括标题。3.将视图更改为工作簿1。4.选择单元格A12。5.右键单击，粘贴。这是驻留在工作簿1中的代码？代码驻留在工作簿1中…目标工作簿。您好，SJR。我收到以下错误：对象不支持此行的此属性或方法。targetSheet.RangeA12:A112.Paste Link:=True同样，我只在一列中发布了我的问题。实际上，需要为其他列标题（如制造商、型号、序列号等）完成查找/复制/粘贴。上面修改的代码。它们应该粘贴在哪里？我将编辑我的原始问题，以包括我的旧代码，这些代码很容易复制错误的列，但工作起来很有魅力。我想这会让事情变得更清楚一点。另外，我真的很感谢你的帮助。我要试试你编辑的代码。修改后的代码效果很好；但是，它正在复制列标题。本质上，它只需要被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