运行时错误"1004"：在代码下面运行时出现应用程序定义或对象定义的错误

Question

当自动滤波且没有数据或仅一种类型的数据时，我会在行上遇到错误

 Set rang = rang.Resize(rang.Rows.Count - 1)

在下面的代码中，我只有来自标准的数据2

Dim rang As Range
    Set sh = Worksheets("ExampleSheet")
           sh.Select
        Range("A1").Select
        Selection.AutoFilter
        sh.UsedRange.AutoFilter Field:=10, Criteria1:= _
            "=*Criteria1*", VisibleDropDown:=False
        Set rang = sh.UsedRange.Offset(1, 0)
        Set rang = rang.Resize(rang.Rows.Count - 1)
        On Error Resume Next
        Set rang = rang.SpecialCells(xlCellTypeVisible)
        If Err.Number = 0 Then
        rang.Select
        rang.Copy
        Sheets("Criteria2").Select
        Range("A1").Select
          ActiveCell.Offset(1, 0).Select
        ActiveSheet.Paste
          sh.Select
        Selection.Delete Shift:=xlUp
        End If
        On Error GoTo 0
       sh.Cells.AutoFilter
        Application.CutCopyMode = False

           sh.Select
        Range("A1").Select
        Selection.AutoFilter
        sh.UsedRange.AutoFilter Field:=10, Criteria1:= _
            "=*Criteria2*", VisibleDropDown:=False
        Set rang = sh.UsedRange.Offset(1, 0)
        Set rang = rang.Resize(rang.Rows.Count - 1)
        On Error Resume Next
        Set rang = rang.SpecialCells(xlCellTypeVisible)
        If Err.Number = 0 Then
        rang.Select
        rang.Copy
        Sheets("Criteria2").Select
        Range("A1").Select
          ActiveCell.Offset(1, 0).Select
        ActiveSheet.Paste
          sh.Select
        Selection.Delete Shift:=xlUp
        End If
        On Error GoTo 0
      sh.Cells.AutoFilter
        Application.CutCopyMode = False

Answer 1

Sub CopyCopy()
    Dim rngUsed As Range, rngCopy As Range
    Dim sht As Worksheet
    Set sht = Sheets("All Data")

    sht.Range("A1").AutoFilter '<<clear any previous filtering
    Set rngUsed = sht.Range("A1").CurrentRegion
    rngUsed.AutoFilter Field:=10, Criteria1:= _
        "=*Criteria2*", VisibleDropDown:=False
    On Error Resume Next
    With rngUsed.Offset(1, 0).Resize(rngUsed.Rows.Count - 1)
        'any visisble rows?
        Set rngCopy = .SpecialCells(xlCellTypeVisible)
    End With
    On Error GoTo 0
    If Not rngCopy Is Nothing Then
        rngCopy.Copy Sheets("Criteria2").Range("A2")
        rngCopy.Delete Shift:=xlUp
        Set rngCopy = Nothing '<<< clear range variable
    End If
    sht.Range("A1").AutoFilter '<<clear any filtering
    'repeat with other criteria or create a loop
End Sub