How to use VBA code to copy rows with filter based on values in another sheet

How to copy rows with filter based on values in another sheet

Requirement:

The user has a workbook with 2 sheets - "criteria" and "data".

"Data" sheet has 7 columns with data. Need to autofilter the data and copy paste the values with filter on column C with criteria mentioned on sheet "Criteria" by creating separate sheets. e.g. in sheet "Criteria" there might be 5 values say asd, ert, 123, a2a, qwe. So 5 separate sheets should be created with data copy pasted from sheet "Data" by applying filter on sheet "Data" in column C one by one with those values. i.e. first filter data in column C by selecting "asd" and pasting that in a new sheet and then filter by selecting "ert" and pasting that in a new sheet and so on.

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/148240-copy-rows-with-filter-based-on-values-in-another-sheet

Solution:

Code:

Option Explicit
Sub FilterAndCopyData()
Dim wsData As Worksheet, wsCriteria As Worksheet, wsDest As Worksheet
Dim lr As Long
Dim rng As Range, cell As Range
Application.ScreenUpdating = False
Set wsData = Sheets("Data")
Set wsCriteria = Sheets("Criteria")

'Assuming the criteria are listed in column A starting from Row2 on Criteria Sheet
lr = wsCriteria.Cells(Rows.Count, "A").End(xlUp).Row
Set rng = wsCriteria.Range("A2:A" & lr)

If wsData.FilterMode Then wsData.ShowAllData

For Each cell In rng
    With wsData.Range("A1").CurrentRegion
        .AutoFilter field:=3, Criteria1:=cell.Value
        On Error Resume Next
        Set wsDest = Sheets(CStr(cell.Value))
        wsDest.Cells.Clear
        On Error GoTo 0
        If wsDest Is Nothing Then
            Sheets.Add(after:=Sheets(Sheets.Count)).Name = cell.Value
            Set wsDest = ActiveSheet
        End If
        wsData.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy wsDest.Range("A1")
        wsDest.UsedRange.Columns.AutoFit
    End With
    Set wsDest = Nothing
Next cell
wsData.AutoFilterMode = False
wsData.Activate
Application.ScreenUpdating = True
End Sub

Obtained from the OzGrid Help Forum.

Solution provided by sktneer.