Filtering data from multiple sheets and consolidate into one,french mba college assignment,vba teacher sourav,kolkata 09748184075

Sub filterdata()

Sheets("Extraction").Select
Cells.Clear
Range("A1").Select
ActiveCell.Value = "userID"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Start"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "End"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Duration"

ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Amount"

Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
MsgBox (ws.Name)

If ws.Name = "D1" Or ws.Name = "D2" Or ws.Name = "D3" Then


Sheets(ws.Name).Select

Dim rList As Range
 On Error Resume Next
With Worksheets(ws.Name).ListObjects("Table1")
    Set rList = .Range
    .Unlist                           ' convert the table back to a range
End With


'filter D1
Sheets(ws.Name).Select

Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.ListObjects.Add(xlSrcRange, Range(Selection.Address), , xlYes).Name = _
        "Table2"
    Range("Table2[#All]").Select
    ActiveSheet.ListObjects("Table2").TableStyle = "TableStyleLight1"
    ActiveSheet.ListObjects("Table2").Name = "Table1"
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=4, Criteria1:= _
        "<8:0 br="" operator:="xlAnd">   
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Extraction").Select
    
    

With Columns("A")
    .Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With

    ActiveSheet.Paste
    
    'filtering D1 completed
    'convert table to range
    
    
Sheets(ws.Name).Select


 On Error Resume Next
With Worksheets(ws.Name).ListObjects("Table1")
    Set rList = .Range
    .Unlist                           ' convert the table back to a range
End With

'table converted to range

   Application.CutCopyMode = False
   End If
   
Next ws
End Sub