运行时错误“1004”：应用程序定义或对象定义错误

Question

我正在尝试从用户输入的选定范围将数据从一张纸复制并粘贴到下一张。 TxtDateStart 采用开始日期，而 TxtDateEnd 采用结束日期。然后它会将日期范围内的数据复制并粘贴到新工作表中。 当我在表单中运行代码时，它可以工作，但我宁愿让表单调用模块。这是我得到运行时错误的地方。我不是VBA专家，将不胜感激。 数据所在的表称为 Unit2Data，我要粘贴数据的表是图形表。

此行出现错误

Sheets("Unit2Data").Range(Cells(i, 1), Cells(i, 73)).Select

Sub Unit2Data()

Dim lrow As Long, i As Long, x As Date, y As Date, erow As Long

x = TxtDateStart
y = TxtDateEnd

'Find the Last Row of Sheet1
lrow = Sheets("Unit2Data").Range("A" & Rows.Count).End(xlUp).Row

'start counting from row 3 to last row
For i = 4 To lrow
' Date value converted as numeric value by multiplying with number 1
If Cells(i, 1) * 1 >= x * 1 Then
If Cells(i, 1) * 1 <= y * 1 Then

'If above conditions matched then select the matched range/ entire column

Sheets("Unit2Data").Range(Cells(i, 1), Cells(i, 73)).Select

'copy the selected row
Selection.Copy

'to make sheet2 active where we want to paste the selected row
Sheets("Graphing Sheet").Activate


'to find the empty row from where the copied row of sheet1 to be pasted in sheet2
erow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

'to activate or select the empty row of sheet2
ActiveSheet.Cells(erow, 1).Select

'paste the copied data
ActiveSheet.Paste

'to deselect the copy and selected mode
Application.CutCopyMode = False

'for above the if we need 3 end if to close if conditions
End If
End If
'to activate sheet1 for searching the matched data
Sheets("Unit2Data").Activate
'continue for look until above matched found
Next i
End Sub

Date              Data 
01/01/2019          2
02/02/2019          3

Answer 1

首先你应该avoid using Select in VBA。几乎总是有更好的方法来实现您使用Select 的目的。

在您的情况下，仅针对提出的特定错误/问题，删除导致错误的行和下一行 (Selection.Copy) 并替换为：

With Sheets("Unit2Data")
    .Range(.Cells(i, 1), .Cells(i, 73)).Copy
End With

重写整个代码以避免使用Select：

Sub Unit2Data()
Dim lrow As Long, i As Long, x As Date, y As Date, erow As Long

x = TxtDateStart
y = TxtDateEnd

With Sheets("Unit2Data")
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    For i = 4 To lrow
        If .Cells(i, 1) * 1 >= x * 1 Then
            If .Cells(i, 1) * 1 <= y * 1 Then
                With Sheets("Graphing Sheet")
                    erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                End With
                .Range(.Cells(i, 1), .Cells(i, 73)).Copy _
                    Destination:= Sheets("Graphing Sheet").Cells(erow, 1)
            End If
        End If
    Next i
End With

End Sub