copy rows from 1 source worksheet to worksheets that match the worksheet name - vba

Question

I have a master worksheet that contains data with many columns.
Next I have also created multiple worksheets from a list.
Now, I would like to copy the rows from the master worksheet to the respective worksheets if the value in the column matches against all the worksheet name, else copy to an 'NA' sheet.
Previously I could only think of hardcoding, but it is not feasible because the number of worksheets may increase to 50+, so I need some help on how I can achieve this..
'find rows of master sheet
With sh
LstR = .Cells(.Rows.Count, "C").End(xlUp).Row 'find last row of column C
Set rng = .Range("C3:C" & LstR) 'set range to loop
End With
'start the loop
'loop through, then loop through each C cell in template. if cell.value == worksheet name, copy to respective worksheet... elseif... else copy to NA
For Each c In rng.Cells
If c = "WEST" Then
c.EntireRow.Copy wsl1.Cells(wsl1.Rows.Count, "A").End(xlUp).Offset(1) 'copy row to first empty row in WEST
ElseIf c = "PKM" Then
c.EntireRow.Copy wsl2.Cells(wsl2.Rows.Count, "A").End(xlUp).Offset(1)
Else
c.EntireRow.Copy wsl7.Cells(wsl7.Rows.Count, "A").End(xlUp).Offset(1)
End If
Next c
Thanks to #user9770531, I was able to do what I want for the macro.
However, now I would like to make the macro more flexible.
For example, I have this additional table in another worksheet with
ColA_id and ColB_group
Instead of just matching checking worksheet name against the values in column C, I would like to do this:
if the master file column C matches "ColA_id", copy the data to respective "ColB_group" worksheets. Assuming ColB_group have been used to create the worksheet names.

Answer 1

Use code bellow - all subs in the same (standard) module
It searches Master.ColumnC for each sheet name (except Master and NA)
Uses AutoFilter for each sheet name, and copies all rows at once
All rows not assigned to a specific sheet will be copied to NA
It assumes sheet NA is already created, with Headers
Option Explicit
Const NA_WS As String = "NA" 'Create sheet "NA" if it doesn't exist
Public Sub DistributeData()
Const MASTER_WS As String = "Master"
Const MASTER_COL As String = "C" 'AutoFilter column in Master sheet
Dim wb As Workbook
Set wb = Application.ThisWorkbook
Dim ws As Worksheet, lr As Long, lc As Long, ur As Range, fCol As Range, done As Range
With wb.Worksheets(MASTER_WS)
lr = .Cells(.Rows.Count, MASTER_COL).End(xlUp).Row
lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set ur = .Range(.Cells(3, 1), .Cells(lr, lc))
Set fCol = .Range(.Cells(2, MASTER_COL), .Cells(lr, MASTER_COL))
Set done = .Range(.Cells(1, MASTER_COL), .Cells(2, MASTER_COL))
End With
Application.ScreenUpdating = False
For Each ws In wb.Worksheets
If ws.Name <> MASTER_WS And ws.Name <> NA_WS Then
fCol.AutoFilter Field:=1, Criteria1:=ws.Name
If fCol.SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
UpdateWs ws, ur
Set done = Union(done, fCol.SpecialCells(xlCellTypeVisible))
End If
End If
Next
If wb.Worksheets(MASTER_WS).AutoFilterMode Then
fCol.AutoFilter
UpdateNA done, ur
End If
Application.ScreenUpdating = True
End Sub
Private Sub UpdateWs(ByRef ws As Worksheet, ByRef fromRng As Range)
fromRng.Copy
With ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1, 0)
.PasteSpecial xlPasteAll
End With
ws.Activate
ws.Cells(1).Select
End Sub
Private Sub UpdateNA(ByRef done As Range, ByRef ur As Range)
done.EntireRow.Hidden = True
If ur.SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
UpdateWs ThisWorkbook.Worksheets(NA_WS), ur.SpecialCells(xlCellTypeVisible)
End If
done.EntireRow.Hidden = False
Application.CutCopyMode = False
ur.Parent.Activate
End Sub