Filter data using Advanced Filter then copy to the bottom data in another table

305 views Asked by At

I am working on a report that will filter data from a table, then copy that data into another sheet, and then delete the rows from the original table. Below is what I have so far, which works, however, I am not sure how to copy the filtered data into another sheet without erasing what was already there. I am new to VBA, so any notes in code would be appreciated. Thanks!

Sub International_Filter()
    
    Dim Working As Range, IntULD As Range, Copyto As Range
    
    ' Working is the datatable that tracking numbers will be filtered, copied, and deleted
    ' INTULD is a list of criteria that needs to be filtered
    ' CopyTO is the sheet where the data will be copied

    Set Working = Sheets("Working").Range("A1").CurrentRegion
    Set IntULD = Sheets("OPC Exception").Range("M6").CurrentRegion    
    Set Copyto = Sheets("International").Range("A1").CurrentRegion    
    On Error Resume Next
    Sheets("Working").ShowAllData
    Working.AdvancedFilter xlFilterCopy, IntULD, Copyto
    Working.AdvancedFilter xlFilterInPlace, IntULD
    Range("A1").Select
    If Range("A9999").End(xlUp).Address = "$A$1" Then
        Exit Sub
    Else
        ActiveCell.Offset(1, 0).Select
        If Cells(Columns("A").Rows.Count, "A").End(xlUp).Row > 2 Then
            Range(selection, Cells(Columns("A").Rows.Count, "O").End(xlUp)).SpecialCells(xlCellTypeVisible).Select
        End If
        selection.EntireRow.Delete
    End If
    On Error Resume Next
    Sheets("Working").ShowAllData
End Sub
1

There are 1 answers

0
Vitalizzare On

How to insert filtered data at the beginning of a destination:

Sub International_Filter()
    Dim Source As Range       ' Data to look at
    Dim Data As Range         ' Filtered data to copy
    Dim Criteria As Range     ' Criteria for Advanced Filter
    Dim Destination As Range  ' Place to copy filtered data
    Dim Area As Range

    Set Source = Sheets("Working").Range("A1").CurrentRegion
    Set Criteria = Sheets("OPC Exception").Range("M6").CurrentRegion    
    Set Destination = Sheets("International").Range("A1")

    With Source
        .AdvancedFilter xlFilterInPlace, Criteria
        On Error Resume Next
        Set Data = .Rows("2:" & .Rows.Count).SpecialCells(xlCellTypeVisible)
        .Parent.ShowAllData
        If Data Is Nothing Then Exit Sub
        For Each Area In Data.Areas
            Area.Copy
            Destination.Insert xlShiftDown
        Next Area
        Data.Delete xlShiftUp
    End With
End Sub

p.s. From my point of view it's better to copy data at the end of existing data. So in this case the last part of the code is:

   ...
   With Sheets("International").UsedRange
      Set Destination = .Range("A1").Offset(.Rows.Count)
   End With
   ...
   If Data Is Nothing Then Exit Sub
   Data.Copy Destination
   Data.Delete xlShiftUp
   ...