자동 필터 다음 복사 및 붙여 넣기 범위

Question

아래 코드를 작성했습니다. 기준을 사용하여 열 K를 자동 필터링하고 데이터를 복사 한 다음 마지막 페이지 바로 아래의 같은 페이지에 붙여 넣으려고합니다.

오류가 발생하지 않지만 코드가 의도 한대로 작동하지 않습니다. 자동 필터 및 복사까지 작동하지만 데이터를 마지막 행에 붙여 넣지는 않습니다. 도움을받을 수 있습니까?

Sub Depreciation_to_Zero() 
With Sheets("Restaurant") 
.AutoFilterMode = False 
With .Range("k1", .Range("k" & .Rows.Count).End(xlUp)) 
    .AutoFilter Field:=1, Criteria1:="*HotDog*" 
    On Error Resume Next 
    .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Copy 
    .Cells(.Rows.Count, "A").End(xlUp).Row.Select.PasteSpecial xlPasteValues 
    On Error GoTo 0 
End With 

.AutoFilterMode = False 
End With 
MsgBox ("Complete") 
End Sub 

Answer 1

---

Option Explicit 

Public Sub DepreciationToZero() 

    Const FIND_VAL = "*HotDog*" 

    Dim ws As Worksheet, lr As Long, result As String 

    Set ws = Worksheets("Restaurant") 
    Application.ScreenUpdating = False 
    ws.AutoFilterMode = False 
    lr = ws.Cells(ws.Rows.Count, "K").End(xlUp).Row 
    result = FIND_VAL & " not found" 

    With ws.UsedRange 
     ws.Range("K1:K" & lr).AutoFilter Field:=1, Criteria1:=FIND_VAL 
     If ws.Range("K1:K" & lr).SpecialCells(xlCellTypeVisible).CountLarge > 1 Then 
      .Offset(1).Resize(lr - 1).SpecialCells(xlCellTypeVisible).Copy 
      .Offset(lr).Cells(1).PasteSpecial xlPasteValues 
      .Offset(lr).Cells(1).Select 
      Application.CutCopyMode = False 
      result = "All " & FIND_VAL & " rows copied" 
     End If 
    End With 

    ws.AutoFilterMode = False 
    Application.ScreenUpdating = True 
    MsgBox result 
End Sub