excel vba - Select all filtered rows except header after autofilter

Question

I'm trying to write a macro to do the following:

• from Sheet1 watch the A column for the data I input;
• when I write something in a cell in the A column use that value to filter Sheet2;
• after the filter is done, copy everything except the column header from the second sheet into the first one, even if there are multiple values.

I tried writing this:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Set KeyCells = Range("A:A")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
        copy_filter Target
    End If
End Sub

Sub copy_filter(Changed)
    Set sh = Worksheets("Sheet2")
    sh.Select

    sh.Range("$A$1:$L$5943") _
        .AutoFilter Field:=3, _
            Criteria1:="=" & Changed.Value, _
            VisibleDropDown:=False
    Set rang = sh.Range("$A$1:$L$5943") _
        .SpecialCells(xlCellTypeVisible)

    rang.Offset(0, 0).Select
    Selection.Copy

    Worksheets("Sheet1").Select
    Worksheets("Sheet1").Range(Changed.Address).Offset(0, 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues

    sh.Range("$A$1:$L$5943").AutoFilter
    Application.CutCopyMode = False
End Sub

However when I copy the selection the header row gets copied as well, but using .Offset(1, 0) cuts the header and 1 additional row and doesn't account for cases when the filter returns no results.

How can I select every filtered rows except for the header?

Answer 1

Use sh.UsedRange will give you a dynamic range. Where as, sh.Range("$A$1:$L$5943") will not shrink and grow to match your dataset.
We can trim the header row off like this:

    Set rang = sh.UsedRange.Offset(1, 0)
    Set rang = rang.Resize(rang.Rows.Count - 1)

But SpecialCells(xlCellTypeVisible) will throw a No cells were found. error if there is no data to return. So we'll have to trap the error like this:

On Error Resume Next

Set rang = rang.SpecialCells(xlCellTypeVisible)

If Err.Number = 0 Then

End If

On Error GoTo 0

Sub copy_filter(Changed)
        Dim rang As Range

        Set sh = Worksheets("Sheet2")

        sh.UsedRange.AutoFilter Field:=3, _
                                Criteria1:="=" & Changed.Value, _
                                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.Copy
            Worksheets("Sheet1").Range(Changed.Address).Offset(0, 1).PasteSpecial Paste:=xlPasteValues
        End If

        On Error GoTo 0

        sh.Cells.AutoFilter

        Application.CutCopyMode = False


    End Sub