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

我的發現：

目前，我在將問題歸結為確切的故障點時遇到了問題。 哪個粘貼失敗似乎是隨機的。 有時，該功能完全完成而沒有任何問題。 我唯一能想到的似乎每次都能使它工作的方法是在運行宏之前將要粘貼的工作表激活。 之所以這樣想，是因為當我選擇調試它時，工作表將激活“ RAW數據”表，然后當我按F8或F5來調試或運行代碼時。 它無需任何其他更改即可工作。

其他說明：

• 我要從中復制的工作簿是從另一個應用程序導出的數據，我想完全自動化一個過程。 因此，在宏運行之前尚未選擇此工作簿。 我不確定這是否對這個問題有影響？

Answer 1

嘗試類似的東西，

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