VBA复制和附加

在删除整行并在底部添加额外的行之前，我正在尝试包含一个副本并附加到新工作表。这就是我目前所拥有的

Sub DeleteRows()

    Dim c As Range
    Dim cell As Range
    Dim SrchRng As Range
    Dim SrchStr As String
    On Error GoTo Err_Execute


    Set SrchRng = ActiveSheet.Range("B1:B5000")
    SrchStr = InputBox("Please Enter Number")
    For Each cell In SrchRng
        If cell.Value = SrchStr Then cell.EntireRow.Delete
    Next cell
    Range("C5499:F5499").Select
    Selection.AutoFill Destination:=Range("C5499:F5500"), Type:=xlFillDefault
    Range("C5499:F5500").Select
    Selection.End(xlUp).Select
   Exit Sub
Err_Execute:
    MsgBox "An error occurred."

End Sub

---

像这样的

Dim cell As Range
Dim SrchRng As Range
Dim SrchStr As String
Dim pasteRow As Long

Set SrchRng = Sheets("Sheet1").Range("B1:B5000")
SrchStr = InputBox("Please Enter Number")
pasteRow = 1

    For Each cell In SrchRng
        If cell.Value = SrchStr Then
            cell.EntireRow.Copy (ThisWorkbook.Sheets("Sheet8").Range("A" & pasteRow).EntireRow)
            pasteRow = pasteRow + 1
            cell.EntireRow.Delete
        End If
    Next cell

---

谢谢你的提示。我设法把它拼凑起来，并得出了以下结论

有关于添加粘贴特殊值的提示吗

Sub DeleteRows()
Dim c As Range
Dim cell As Range
Dim SrchRng As Range
Dim SrchStr As String
Dim lastRow As Long





On Error GoTo Err_Execute


Set SrchRng = Sheets("Incubate").Range("B8:B5000")
SrchStr = InputBox("Please Enter Lab Number")
lastRow = Sheets("Fridge").Range("B65536").End(xlUp).Row + 1

   For Each cell In SrchRng

   If cell.Value = "" Then
    Exit For
    End If

  If cell.Value = SrchStr Then
       cell.EntireRow.Copy Destination:=Sheets("Fridge").Range("a" & lastRow)
       cell.EntireRow.Delete

  End If

Next cell

Range("C5499:F5499").Select
Selection.AutoFill Destination:=Range("C5499:F5500"), Type:=xlFillDefault
Range("C5499:F5500").Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
Range("B8").Select
Exit Sub
Err_Execute:
MsgBox "An error occurred."

End Sub

---

不太理解您试图对RangeC5499:F5499执行的操作。选择Selection.AutoFill Destination:=RangeC5499:F5500，键入：=xlFillDefault RangeC5499:F5500.Select Selection.EndxlUp.Selectthis将公式复制到下一行，因此工作表中始终有5000行。每次删除一行时，它都会在底部添加一行。这是完美的，我只需要添加复制和粘贴/ammend sectionCopy what到结束行？