VBA - Filter and copy data to another tab, at bottom of existing data

[AndyRaab]

I have a four column data table that has an SQL code to refresh itself. This then needs to be filtered on column 4 (D) to value "N" (it is a vlookup against existing data in another tab, producing N when it is NOT there), and copied to the last row of the existing table. Current VBA code does not filter, but correctly only copies the first 3 columns (A to C). Please see below for code - I want the formulas and formatting to happen too, so it is really only the "filter and copy" I need:

Sub Update()

'Does ALL of the possible AUTO work
'Find the last used row in both sheets and copy and paste data below existing data.
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
  'Set variables for copy and destination sheets
  Set wsCopy = Worksheets("Data")
  Set wsDest = Worksheets("UPDATE_SHEET")
    
  '1. Find last used row in the copy range based on data in column A
  lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
    
  '2. Find first blank row in the destination range based on data in column A
  'Offset property moves down 1 row
  lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
  '3. Copy & Paste Data
  wsCopy.Range("A2:C" & lCopyLastRow).Copy _
    wsDest.Range("A" & lDestLastRow)
    
    
    'Check if to be reported on
    
    Dim LastRow As Long
    
    With Sheets("UPDATE_SHEET")
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("D2:D" & LastRow).Formula = _
            "=VLOOKUP($B2,List!$A:$C,2,FALSE)"
    End With
    
    'Convert DeliveryDate into an actual date

    
    With Sheets("UPDATE_SHEET")
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("E2:E" & LastRow).Formula = _
            "=DATEVALUE($A2)"
    End With

    'Lookup grouped depot name

    
    With Sheets("UPDATE_SHEET")
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("F2:F" & LastRow).Formula = _
            "=VLOOKUP($B2,List!$A:$C,3,FALSE)"
    End With
    'Get month for summary tab
    
    With Sheets("UPDATE_SHEET")
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("G2:G" & LastRow).Formula = _
            "=TEXT($E2,""MMM"")"
    End With

    'copies formatting to last row
    
    Application.ScreenUpdating = False
    
    LastRow = ActiveSheet.Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
    LastColumn = ActiveSheet.Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
        
    ' Copy Format Down
    Range(Cells(3, 1), Cells(3, 9)).Copy
    Range(Cells(3, 1), Cells(3, 9)).Resize(LastRow - 2, 9). _
        PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
    'Selects A1
    
    Range("A1").Select
    Application.CutCopyMode = False
    
End Sub

 

[atulsanwal22]

Hi DanteAmor,

Can you pls help me, i am also facing the same issue. Below is the link of the error i am getting

Copy filtered data to same sheet using VBA

Here is the Code I have written a code to filter a range of data by 2 different criteria. first criteria is if the cell value contains "." for example - stack.overflow then it should filter it out

stackoverflow.com