我编写了一个程序来复制第三方程序中的数据并将其粘贴到我工作的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的情况下粘贴的位置。
任何帮助将不胜感激。
编辑:很抱歉让代码退出。这是一个与工作相关的计划,所以我不确定我应该发布多少。它也有点长,我不知道有多少相关。但这里有一些代码。如果你仍然需要更多,我可以发布整个事情,我只需要编辑敏感位。
答案 0 :(得分:0)
我猜错误来自这一行:
RQWB.Worksheets("Email_List").Range("D1").End(xlDown).Offset(1, -3).Copy
你能澄清一下你想做什么吗?