pastespecial导致宏在一台计算机上失败,但不是任何其他计算机

时间:2016-12-13 06:56:40

标签: excel vba excel-vba macros

我编写了一个程序来复制第三方程序中的数据并将其粘贴到我工作的excel表中。在我运行宏的5台计算机中的4台上,一切都运行良好。然而,这最后一台计算机生成

运行时错误“1004”:范围类的PasteSpecial方法失败。

我最后一次遇到此错误是因为我在脚本中使用了Cell.Activate。我已经重新编写它以避免使用它,但是一台计算机仍然存在问题。为什么会这样?

该程序基本上将窗口切换到仅接受键盘输入作为输入的第三方程序。我使用sendkeys来获取我需要的数据,然后将其复制并粘贴到excel,我可以处理数据。

我在程序中更早地调暗并设置了RQWB,但这里有一行。

Dim RQWB As Workbook
Set RQWB = Workbooks("Excel workbook")

这是周围的for循环。

            'find missing emails
For count3 = 0 To 200
    If IsEmpty(RQWB.Worksheets("Email_List").Range("D1").End(xlDown).Offset(1, -3).Value) = True Then

    Else

        RQWB.Worksheets("Email_List").Range("D1").End(xlDown).Offset(1, -3).Copy

        AppActivate "Other program"
        Sleep 500
        SendKeys "~", True
        Sleep 70
        SendKeys "~", True
        Sleep 70
        SendKeys "~", True
        Sleep 70
        SendKeys "~", True
        Sleep 70
        SendKeys "~", True
        Sleep 70
        SendKeys "~", True
        Sleep 70
        SendKeys "~", True 
        Sleep 70
        SendKeys "1", True
        Sleep 70
        SendKeys "~", True 
        Sleep 70
        SendKeys "2", True
        Sleep 70
        SendKeys "~", True 
        Sleep 70
        SendKeys "1", True
        Sleep 70
        SendKeys "~", True 
        Sleep 70
        SendKeys "c ", True 
        Sleep 70
        SendKeys "^v", True 
        Sleep 70
        SendKeys "^x", True 
        Sleep 70            
        SendKeys "^a", True 
        Sleep 70            
        SendKeys "^c", True 
        Sleep 70
        RQWB.Worksheets("Data").Cells.Delete
        RQWB.Worksheets("Data").Range("A1").PasteSpecial
        Sleep 500
        If RQWB.Worksheets("Data").Range("A24").Value = "CONDITION" Then
            RQWB.Worksheets("Email_List").Range("D1").End(xlDown).Offset(1, 0).EntireRow.Delete
            AppActivate "OTHER PROGRAM"
            Sleep 500
            SendKeys "~", True
            Sleep 70
        ElseIf RQWB.Worksheets("Data").Range("A24").Value = "CONDITION" Then
            RQWB.Worksheets("Data").Range("D24").Value = "=LEFT(A6, 6)"
            RQWB.Worksheets("Data").Range("D24").Copy
            AppActivate "OTHER PROGRAM"
            Sleep 500
            SendKeys "^v", True
            Sleep 70
            SendKeys "30", True
            Sleep 70
            SendKeys "~", True
            Sleep 70
            SendKeys "^x", True
            Sleep 70
            SendKeys "^a", True
            Sleep 70
            SendKeys "^c", True
            Sleep 70
            RQWB.Worksheets("Data").Cells.Delete
            RQWB.Worksheets("Data").Range("A1").PasteSpecial
            If RQWB.Worksheets("Data").Range("A8").Value = "CONDITION" Then
                Sleep 70
                AppActivate "OTHER PROGRAM"
                Sleep 500
                SendKeys ("3")
                Sleep 70
                SendKeys ("~")
                Sleep 70
                SendKeys "^x", True
                Sleep 70
                SendKeys "^a", True
                Sleep 70
                SendKeys "^c", True
                Sleep 70
                RQWB.Worksheets("Data").Cells.Delete
                RQWB.Worksheets("Data").Range("A1").PasteSpecial
                Sleep 70
                If IsEmpty(RQWB.Worksheets("Data").Range("A21").Value) = True Then
                    RQWB.Worksheets("Email_List").Range("D1").End(xlDown).Offset(1, 0).EntireRow.Delete
                Else
                    RQWB.Worksheets("Email_List").Range("D1").End(xlDown).Offset(1, 0).Value = RQWB.Worksheets("Data").Range("A21").Value
                End If
            End If
        ElseIf RQWB.Worksheets("Data").Range("A2").Value = "===============================================================================" Then
            AppActivate "OTHER PROGRAM"
            Sleep 500
            SendKeys "30", True
            Sleep 70
            SendKeys "~", True
            Sleep 70
            SendKeys "^x", True
            Sleep 70
            SendKeys "^a", True
            Sleep 70
            SendKeys "^c", True
            Sleep 70
            RQWB.Worksheets("Data").Cells.Delete
            RQWB.Worksheets("Data").Range("A1").PasteSpecial
            Sleep 500
            If RQWB.Worksheets("Data").Range("A8").Value = "CONDITION" Then
                Sleep 70
                AppActivate "OTHER PROGRAM"
                Sleep 500
                SendKeys ("3")
                Sleep 70
                SendKeys ("~")
                Sleep 70
                SendKeys "^x", True
                Sleep 70
                SendKeys "^a", True
                Sleep 70
                SendKeys "^c", True
                Sleep 70
                RQWB.Worksheets("Data").Cells.Delete
                RQWB.Worksheets("Data").Range("A1").PasteSpecial
                Sleep 70
                If IsEmpty(RQWB.Worksheets("Data").Range("A21").Value) = True Then
                    RQWB.Worksheets("Email_List").Range("D1").End(xlDown).Offset(1, 0).EntireRow.Delete
                Else
                    RQWB.Worksheets("Email_List").Range("D1").End(xlDown).Offset(1, 0).Value = RQWB.Worksheets("Data").Range("A21").Value
                End If
            End If
        End If
    End If
Next count3

我正在运行此脚本,隐藏了工作簿,因此我需要添加RQWB来告诉excel在没有.activate的情况下粘贴的位置。

任何帮助将不胜感激。

编辑:很抱歉让代码退出。这是一个与工作相关的计划,所以我不确定我应该发布多少。它也有点长,我不知道有多少相关。但这里有一些代码。如果你仍然需要更多,我可以发布整个事情,我只需要编辑敏感位。

1 个答案:

答案 0 :(得分:0)

我猜错误来自这一行:

RQWB.Worksheets("Email_List").Range("D1").End(xlDown).Offset(1, -3).Copy

你能澄清一下你想做什么吗?