オートフィルタをコピーして貼り付け範囲

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

何.AutoFilterが現在ないときにどのように最初の `.AutoFilterMode = false`を扱っている？

---

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