搜索用户输入的命名区域，并将找到输入的行复制/粘贴到第二个工作表中

Question

我有一个宏，提示用户输入日期(例如4/27/21(，然后vba将在命名范围(date_range(中搜索每个有输入的单元格。然后我需要复制找到日期的整行，并将其粘贴到另一个工作表上。我附上了一个我正在搜索的工作表范围的片段，它要大得多，但作为一个例子应该可以。该范围中的某些日期字段由公式填充，当它们被复制到新工作表时，会出现错误。我有两个问题：

1.(如果我在调试器中逐步完成此代码，它就会工作。但当我运行它时，excel在崩溃前会冻结一段时间。数据范围为$G$5:$AS$175。搜索用户输入的日期是不是太大了？

2.(将行复制到另一个工作表时，如何修复公式错误？

Dim key As Variant
Dim c As Range
Dim firstaddress As String
Dim n As Integer
n = 0
key = InputBox("Please enter a date", "Search")
With Worksheets("Data").Range("date_range")
Set c = .Find(key, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
c.EntireRow.Copy Sheets("Search").Range("A2").Offset(n, 0)
Set c = .FindNext(c)
n = n + 1
Loop While Not c Is Nothing
End If
End With

较小示例范围

运行高于代码的结果

Answer 1

我能够弄清楚这一点。这是下面的代码

Dim key As Variant
Dim c As Range
Dim firstaddress As String
Dim n As Integer
Dim rdest As Long
rdest = Sheets("Search").Range("A" & Sheets("Search").Rows.Count).End(xlUp).Row + 1
key = InputBox("Please enter a date", "Search")
With Worksheets("Data").Range("date_range")
Set c = .Find(key, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
c.EntireRow.Copy
Sheets("Search").Range("A" & rdest).PasteSpecial Paste:=xlPasteValues
Set c = .FindNext(c)
rdest = rdest + 1
Loop While c.Address <> firstaddress
End If
End With
End Sub