底部空白时复制过滤数据

Sub AutoFilterCopyBottomBlanks()
    
    Const TURN_OFF_AUTOFILTER As Boolean = True
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim MySheet As Worksheet: Set MySheet = wb.Sheets("Sheet1")
    
    ' Reference the table range ('trg')
    ' excluding any consecutive bottom-most rows that are blank.
    
    Dim trg As Range, drCount As Long
    
    With MySheet
        ' Turn off auto filtering (for the 'Find' method to work correctly).
        ' Also, make sure there are no hidden rows because the 'Find' method
        ' due to 'xlValues' will fail if any consecutive bottom-most rows
        ' are hidden.
        If .AutoFilterMode Then .AutoFilterMode = False
        ' Note that '.ShowAllData' is unsafe since the auto filter could
        ' be applied to only a portion of the range.
        With .UsedRange
            Dim lcell As Range:
            Set lcell = .Find("*", , xlValues, , xlByRows, xlPrevious)
            If lcell Is Nothing Then Exit Sub ' the worksheet is blank
            drCount = lcell.Row - .Row ' data rows (header row excluded)
            If drCount = 0 Then Exit Sub ' only a single row (headers!?)
            Set trg = .Resize(drCount + 1)
        End With
    End With
    
    ' Apply the filter (modify as required).
    trg.AutoFilter 1, "Criteria" '
        
    ' Attempt to reference the filtered rows ('vrg' - visible range).
    Dim vrg As Range:
    On Error Resume Next ' prevent error if no cells found
        Set vrg = trg.Resize(drCount).Offset(1).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ' Turn off auto filtering. It is optional in case of copying.
    ' It is a necessary step to not to have to delete
    ' entire rows when deleting the filtered rows.
    If TURN_OFF_AUTOFILTER Then
        MySheet.AutoFilterMode = False
    End If
    
    If vrg Is Nothing Then Exit Sub ' no filtered rows
    
    ' Continue with the copy code...
    vrg.Copy

End Sub

如果没有可见的数据（所有数据行都被隐藏），OP的代码将引发1004。
试试看吧

Sub Demo()
    Dim c As Range, mysheet As Worksheet
    Set mysheet = ActiveSheet
    On Error Resume Next
    Set c = mysheet.UsedRange.Offset(1, 0).Resize(mysheet.UsedRange.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Not c Is Nothing Then
        c.Copy
    Else
        MsgBox "No data"
    End If
End Sub

• Microsoft文档：*

Range.SpecialCells method (Excel)