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

AndyRaab

New Member
Joined
Apr 19, 2019
Messages
5
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:

Code:
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
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Do you want the filter to be done after copying columns and executing the formulas?
 
Upvote 0
Hello,

It would be filtered before copying,as I don't want the data duplicated in the second tab (it could be that the data is refreshed a few times in a day, but the SQL won't know what is already in tab2 - if that makes sense?)
 
Upvote 0
Try this:

Code:
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
  
[COLOR=#0000ff]  'filter & copy[/COLOR]
[COLOR=#0000ff]    Dim OtherTab As Worksheet, lr2 As Long[/COLOR]
[COLOR=#0000ff]    Set OtherTab = Sheets("Sheet2")[/COLOR]
[COLOR=#0000ff]    wsDest.ShowAllData[/COLOR]
[COLOR=#0000ff]    wsDest.Range("A1").AutoFilter 4, "N"[/COLOR]
[COLOR=#0000ff]    wsDest.Range("A2:A" & lDestLastRow).EntireRow.Copy[/COLOR]
[COLOR=#0000ff]    lr2 = OtherTab.Cells(OtherTab.Rows.Count, "A").End(xlUp).Row + 1[/COLOR]
[COLOR=#0000ff]    OtherTab.Range("A" & lr2).PasteSpecial xlPasteValues[/COLOR]
[COLOR=#0000ff]    wsDest.ShowAllData[/COLOR]
  
  '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
 
Upvote 0
THanks, I get an error on Set OtherTab = Sheets("Sheet2") - this I think defines what is already called wsDest earlier in the code which I think I need to replace (OtherTab) with here?

Code:
'filter & copy
    Dim OtherTab As Worksheet, lr2 As Long
    Set OtherTab = Sheets("Sheet2")
    wsDest.ShowAllData
    wsDest.Range("A1").AutoFilter 4, "N"
    wsDest.Range("A2:A" & lDestLastRow).EntireRow.Copy
    lr2 = OtherTab.Cells(OtherTab.Rows.Count, "A").End(xlUp).Row + 1
    OtherTab.Range("A" & lr2).PasteSpecial xlPasteValues
    wsDest.ShowAllData
 
Upvote 0
You said:

Filter and copy data to another tab

Then create another sheet called "Sheet2".
What I understand is that there is data in the "UPDATE_SHEET" sheet and before copying the data from the "DATA" sheet to "UPDATE_SHEET" you first want to copy from "UPDATE_SHEET" to othersheet.
it is right?
If it is not correct, then you can explain the sequence of steps you require.
 
Upvote 0
I need to:
Filter "Data" by column 4 = "N"
Copy only column 1-3 on "Data" after filter
Paste this onto row under last row in "Update_Sheet"

It already does the paste where I need it (last line in below), but only copies all of the columns 1-3 of the "Data" tab

-------

Code:
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)
[/code
 
Upvote 0
Try this

Code:
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
  
[COLOR=#0000ff]  '3. fFilter, copy & paste data[/COLOR]
[COLOR=#0000ff]    wsCopy.Range("A1").AutoFilter 4, "N"[/COLOR]
[COLOR=#0000ff]    wsCopy.Range("A2:C" & lDestLastRow).Copy[/COLOR]
[COLOR=#0000ff]    wsDest.Range("A" & lDestLastRow).PasteSpecial xlPasteValues[/COLOR]
[COLOR=#0000ff]    wsCopy.ShowAllData[/COLOR]
  
  '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
 
Upvote 0
@Dante Amor:
Thank you so much for your help! The ShowAllData section errors, but I have removed that as the original data is longer required for anything once it is copied into the new tab.
Thank you again!
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,949
Members
448,534
Latest member
benefuexx

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top