EXCEL VBA - 从另一个 Excel 实例复制到活动工作簿时出错

Question

我想要什么：

我只需要能够从另一个打开的 excel 实例（应用程序）中复制某些列，具体取决于标题。

到目前为止我所拥有的：

Sub Import_Data()

Dim wb As Workbook
Dim c As Range
Dim headrng As Range
Dim lasthead As Range
Dim headrng1 As Range
Dim lasthead1 As Range
Dim LogDate As Range
Dim LastRow As Range
Dim BottomCell As Range
Dim MONTHrng As Range
Dim Lastrng As Range
Dim PRIhead As Range
Dim LOGhead As Range
Dim TYPEhead As Range
Dim CALLhead As Range
Dim DEShead As Range
Dim IPKhead As Range
Dim COPYrng As Range
Dim MONTHhead As Range
Dim YEARhead As Range

With ActiveWorkbook
    Application.ScreenUpdating = False
End With

'On Error GoTo ErrorHandle
Set wb = GetObject("Book1")

'If Book1 is found
If Not wb Is Nothing Then
    'Copy all Cells

    With wb.Worksheets("Sheet1")
        Set lasthead1 = .Range("1:1").Find(What:="*", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
        Set headrng1 = .Range("A1", lasthead1)
        For Each c In headrng1
            If Left(c, 1) = "-" Then c = Mid(c, 2, Len(c) - 1)
            If Left(c, 1) = "+" Then c = Mid(c, 2, Len(c) - 1)
        Next c

        'Insert new column and format it to the month value of log date
        Set LastRow = .Range("A:A").Find(What:="*", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
        Set LogDate = headrng1.Find(What:="Log Date", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
        Set BottomCell = .Cells(LastRow.Row, LogDate.Offset(0, 1).Column)
        LogDate.EntireColumn.Offset(0, 1).Insert
        LogDate.EntireColumn.Offset(0, 1).Insert
        Set MONTHrng = .Range(LogDate.Offset(0, 1), BottomCell.Offset(0, -2))
        MONTHrng = "=Month(RC[-1])"
        MONTHrng.Offset(0, 1) = "=Year(RC[-2])"
        LogDate.Offset(0, 1).Value = "Month Number"
        LogDate.Offset(0, 2).Value = "Year Number"
        MONTHrng.EntireColumn.NumberFormat = "General"
        MONTHrng.Offset(0, 1).EntireColumn.NumberFormat = "General"


        Set PRIhead = headrng1.Find(What:="Priority", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
        Set LOGhead = headrng1.Find(What:="Log Date", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
        Set TYPEhead = headrng1.Find(What:="Type", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
        Set CALLhead = headrng1.Find(What:="Call Status", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
        Set DEShead = headrng1.Find(What:="Description", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
        Set IPKhead = headrng1.Find(What:="IPK Status", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
        Set MONTHhead = headrng1.Find(What:="Month Number", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
        Set YEARhead = headrng1.Find(What:="Year Number", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
        PRIhead.EntireColumn.Copy
    End With

ActiveWorkbook.Worksheets("RAW Data").Cells.Clear
    With ActiveWorkbook.Worksheets("RAW Data")
        'Paste Values
        .Range("A1").PasteSpecial xlPasteValues
    End With

    With wb.Worksheets("Sheet1")
        wb.Application.CutCopyMode = False
        LOGhead.EntireColumn.Copy
    End With

    With ActiveWorkbook.Worksheets("RAW Data")
        'Paste Values
        .Range("B1").PasteSpecial xlPasteValues
    End With

    With wb.Worksheets("Sheet1")
        wb.Application.CutCopyMode = False
        MONTHhead.EntireColumn.Copy
    End With

    With ActiveWorkbook.Worksheets("RAW Data")
        'Paste Values
        .Range("C1").PasteSpecial xlPasteValues
    End With

    With wb.Worksheets("Sheet1")
        wb.Application.CutCopyMode = False
        YEARhead.EntireColumn.Copy
    End With

    With ActiveWorkbook.Worksheets("RAW Data")
        'Paste Values
        .Range("D1").PasteSpecial xlPasteValues
    End With

    With wb.Worksheets("Sheet1")
        wb.Application.CutCopyMode = False
        TYPEhead.EntireColumn.Copy
    End With

    With ActiveWorkbook.Worksheets("RAW Data")
        'Paste Values
        .Range("E1").PasteSpecial xlPasteValues
    End With

    With wb.Worksheets("Sheet1")
        wb.Application.CutCopyMode = False
        CALLhead.EntireColumn.Copy
    End With

    With ActiveWorkbook.Worksheets("RAW Data")
        'Paste Values
        .Range("F1").PasteSpecial xlPasteValues
    End With

    With wb.Worksheets("Sheet1")
        wb.Application.CutCopyMode = False
        DEShead.EntireColumn.Copy
    End With

    With ActiveWorkbook.Worksheets("RAW Data")
        'Paste Values
        .Range("G1").PasteSpecial xlPasteValues
    End With

    With wb.Worksheets("Sheet1")
        wb.Application.CutCopyMode = False
        IPKhead.EntireColumn.Copy
    End With

    With ActiveWorkbook.Worksheets("RAW Data")
        'Paste Values
        .Range("H1").PasteSpecial xlPasteValues

        'Set Cells height to 15
        .Cells.RowHeight = 15
        'Set all Columsn to Autofit
        .Cells.Columns.AutoFit
    End With

    'Clear the clipboard
    wb.Application.CutCopyMode = False
    'Close the Book1
    wb.Close False

Else
    'If no Book1 found display output
    MsgBox "Please ensure that you have opened the data from infra"
End If

With ActiveWorkbook.Worksheets("RAW Data")
    'Set all Headers as Range
    Set lasthead = .Range("1:1").Find(What:="*", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
    Set headrng = .Range("A1", lasthead)

    'Remove - or + from headers
    For Each c In headrng
        If Left(c, 1) = "-" Then c = Mid(c, 2, Len(c) - 1)
        If Left(c, 1) = "+" Then c = Mid(c, 2, Len(c) - 1)
    Next c




End With
ErrorHandle:

With ActiveWorkbook
    Application.ScreenUpdating = True
End With

MsgBox "New Data has been Imported"

End Sub

什么不起作用：

问题似乎与过去的功能有关。

错误代码：

Range 类的PasteSpecial 方法失败

在调试时，它会突出显示以下任何代码示例：

.Range("F1").PasteSpecial xlPasteValues

我的发现：

目前，我在将其归结为确切的故障点时遇到了问题。哪个粘贴失败似乎是随机的。有时该功能完全没有问题地完成。我唯一能想到的似乎让它每次都能工作的事情是在我运行宏之前让我粘贴的工作表处于活动状态。之所以这么想是因为当我选择调试它时，工作表会激活“原始数据”表，然后当我按下 F8 或 F5 来调试或运行代码时。它无需进行任何其他更改即可工作。

其他说明：

• 我从中复制的工作簿是从另一个应用程序导出的数据，我想要完全自动化流程。因此，在宏运行之前尚未选择此工作簿。我不确定这是否会对这个问题产生任何影响？

Answer 1

试试类似的，

.Range("G1").PasteSpecial(XlPasteType.xlPasteValues)