尝试在单独的工作表中复制粘贴单元时,VBA运行时错误1004

时间:2015-02-04 15:20:26

标签: excel vba excel-vba range runtime-error

我目前在VBA Excel 2007代码中出现以下错误:运行时错误“1004”:对象'_Worksheet'的方法'Range'失败。通过标题中的这个错误解决了很多问题,我还没有找到类似的情况或解决我的问题。也就是说,不将我的变量声明为公共变量,我不想这样做,因为我在不同的子程序中多次使用相同的变量。

错误在线提出:

AccDnn.Range(Cells(2, 71), Cells(RangéeFinAcc - 1, 87)).Copy

我的代码:

Private Sub SaveRedButton_Click()

Dim SaveRedMssg As String, SaveRedTitre As String, SaveRedButtons As Integer, SaveRedAns As Integer
Dim RangéeFinRed As Long, DrpRed As Worksheet
Dim RangéeFinAcc As Long, AccDnn As Worksheet

    Application.ScreenUpdating = False

    Set DrpRed = ThisWorkbook.Worksheets("Drapeaux Rouges")
    Set AccDnn = ThisWorkbook.Worksheets("Acc. données")

    RangéeFinRed = DrpRed.Cells(Rows.Count, 1).End(xlUp).Row
    RangéeFinAcc = AccDnn.Cells(Rows.Count, 75).End(xlUp).Row
    DrpRed.Cells(8, 2) = RangéeFinRed
    DrpRed.Cells(9, 2) = RangéeFinAcc

    SaveRedTitre = "Enregistrement des données"
    SaveRedMssg = "Voulez-vous enregistrer les données du formulaire" & vbNewLine & "«Drapeaux Rouges - Bobineuse»?"
    SaveRedButtons = vbYesNo + vbQuestion + vbDefaultButton1 + vbApplicationModal
    SaveRedAns = MsgBox(SaveRedMssg, SaveRedButtons, SaveRedTitre)

    If SaveRedAns = 6 Then
            AccDnn.Range(Cells(2, 71), Cells(RangéeFinAcc - 1, 87)).Copy
            AccDnn.Cells(RangéeFinRed - 18, 71).PasteSpecial (xlPasteValues)
            DrpRed.Range(Cells(19, 1), Cells(RangéeFinRed, 16)).Copy
            AccDnn.Cells(2, 75).PasteSpecial (xlPasteValues)
        Else: SaveRedAns = 7
            Application.ScreenUpdating = True
            Exit Sub
    End If

    Application.ScreenUpdating = True

End Sub

此代码的目的是将数据从一张纸上的输入页传输到数据存储表,所有这些都在同一工作簿中。数据从上到下编译到数据表中。因此,代码必须读取应将多少行数据添加到数据存储表中,然后移动数据存储表中的数据,以便为输入数据腾出空间。

1 个答案:

答案 0 :(得分:4)

更新此部分:

If SaveRedAns = 6 Then
        With AccDnn
            .Range(.Cells(2, 71), .Cells(RangéeFinAcc - 1, 87)).Copy
            .Cells(RangéeFinRed - 18, 71).PasteSpecial (xlPasteValues)
        End With
        With DrpRed
            .Range(.Cells(19, 1), .Cells(RangéeFinRed, 16)).Copy
        End With
        AccDnn.Cells(2, 75).PasteSpecial (xlPasteValues)
    Else: SaveRedAns = 7
        Application.ScreenUpdating = True
        Exit Sub
End If

或者不使用With语句:

If SaveRedAns = 6 Then
        AccDnn.Range(AccDnn.Cells(2, 71), AccDnn.Cells(RangéeFinAcc - 1, 87)).Copy
        AccDnn.Cells(RangéeFinRed - 18, 71).PasteSpecial (xlPasteValues)
        DrpRed.Range(DrpRed.Cells(19, 1), DrpRed.Cells(RangéeFinRed, 16)).Copy
        AccDnn.Cells(2, 75).PasteSpecial (xlPasteValues)
    Else: SaveRedAns = 7
        Application.ScreenUpdating = True
        Exit Sub
End If