Autofilter Copy Paste

Hi All,

Problem Statement: Here daily on the 'DATA' worksheet, I need to apply autofilter, then get the data in below sequence and copy to a new worksheet and also send to the Backup workbook & store there the daily work in the respective columns.

1) Apply autofilter on 'To be Done Date' and copy: We just need to everyday take out the entire rows of the next date (tomorrow's date) value. If the left side cells are blank in the column 'E' on the tomorrow's date then we just need to write there 'No Response' before copying the data to a new worksheet.

2) Apply autofilter on 'Response': Here we would filter the data in just two categories — 'Blank' and 'Non Blank' cells, and just take out the entire rows of the non-blank values.


Please see my codes in the attached; I'm unable to find out the further way to the destination. Here I am unable to copy the filtered data and paste into a worksheet then send the same data to the 'Backup' workbook.

Please see the attached and help me out.

Thanks in advance!

MS Excel: 2007

I've just tried with below codes:

Option Explicit

' In a Module

Sub GetDATA()
'

    Workbooks("Autofilter Copy Paste.xlsm").Activate
    Call DelGetDATA
    Worksheets.Add().Name = "GetDATA"
    Cells.Clear
    
    Worksheets("DATA").Select
    Worksheets("Data").AutoFilterMode = False       'removes AutoFilter if one exists

    ActiveSheet.Cells.EntireColumn.Hidden = False
    ActiveSheet.Cells.EntireRow.Hidden = False
    
    
    Range("B2").Select
    Do Until ActiveCell.Value = ""
    
        If ActiveCell.Value <> "" And ActiveCell.Offset(0, 4).Value = VBA.Date + 1 And ActiveCell.Offset(0, 3).Value = "" Then
            ActiveCell.Offset(0, 3).Value = "No Response"
        End If
        
        
        If ActiveCell.Value <> "" And ActiveCell.Offset(0, 2).Value = "" Then
                ActiveCell.Offset(0, 6).Value = "ALFA No. Missing"
        ElseIf ActiveCell.Value <> "" And ActiveCell.Offset(0, 2).Value >= 800 Then    'Remove the quotation marks from "800" for a numerical comparison instead of a string comparison.
                ActiveCell.Offset(0, 6).Value = "Hollywood"
            Else
                ActiveCell.Offset(0, 6).Value = "OTHER"
        End If
            
            ActiveCell.Offset(1, 0).Select
    Loop
        
        
    If Not ActiveSheet.AutoFilterMode Then
        ActiveSheet.Range("A1").AutoFilter
    End If
    
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).AutoFilter Field:=6, Operator:= _
        xlFilterValues, Criteria1:=VBA.Date + 1
    ActiveSheet.ShowAllData
    
    Range("E1").Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).AutoFilter Field:=5, Criteria1:="<>"
    ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy _
       Destination:=Worksheets("GetDATA").Range("A2")
    'Cells.Select
    Worksheets("GetDATA").Cells.EntireColumn.AutoFit


    'Here I am unable to copy the filtered data and paste into a worksheet then send the same data to the 'Backup' workbook.
    
    ActiveSheet.ShowAllData
    
    'Call DelGetDATA

End Sub

' ==================================================

Sub DeleteGetDATA()
' Deletes GetDATA worksheet in the active workbook

    Application.DisplayAlerts = False
    Worksheets("GetDATA").Delete
    Application.DisplayAlerts = True
End Sub

' ==================================================

Sub DelGetDATA()
' Deletes GetDATA worksheet in the active workbook
    
    Dim GetDATA As Worksheet
    
    Workbooks("Autofilter Copy Paste.xlsm").Activate
    If MsgBox("Would you like to delete the sheet: " & "GetDATA" & "?", vbYesNo, "Delete sheet?") = vbYes Then
        Application.DisplayAlerts = False
        On Error Resume Next
        ActiveWorkbook.Sheets("GetDATA").Delete
        On Error GoTo 0
    End If
    
    Application.DisplayAlerts = True
End Sub