VBA 복사 및 추가

Question

임 복사본을 포함하고 새 워크 시트에 추가하려고 시도하기 전에 전체 행을 삭제하고 맨 아래에 여분의 행을 추가하십시오. 이것은 내가 지금까지 가지고있는 것입니다.

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 

Answer 1

이렇게 뭔가?

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 

Answer 2

감사합니다. 나는 그것을 함께 조각 냈고 다음을 생각해 내었다.

붙여 넣기 (값) 추가에 대한 힌트가 있습니까?

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