Question

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

此行中发生错误

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

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

1 个答案: