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

Question

我已经创建（读取：悲惨地失败了）一个 Excel 宏来自动复制列，基于 header，从一个工作簿到另一个工作簿。到目前为止，一切正常，直到我找到 Find 方法。抛出的错误显示为 "Type mismatch."

在我的示例中，必须打开两个工作簿才能使用运行的宏。请注意，源工作簿的列 headers 从第 2 行开始。我想 select 基于 header 的列，但只复制 header 下方的单元格（例如数据）。

任何人都可以深入了解我做错了什么吗？谢谢！

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

我对此进行了编辑，以包含我的原始代码，它运行起来非常棒，但很容易出错。如果源工作簿的列碰巧乱序（很常见），那么它们将无法按正确的顺序粘贴到目标工作表中。因此，为什么我要尝试调整宏，以便根据列 header 进行复制和粘贴。这样，源工作簿中列的顺序就没有意义了。

'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

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

Excel VBA: Code Breaking During Find Method

excel

vba

copy-paste