ks1102,
I am assuming that in the active sheet your titles are in row 2, and your data begins in row 3.
Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).
Adding the Macro
1. Copy the below macro, by highlighting the macro code and pressing the keys CTRL+C
2. Open your workbook
3. Press the keys ALT+F11 to open the Visual Basic Editor
4. Press the keys ALT+I to activate the Insert menu
5. Press M to insert a Standard Module
6. Paste the code by pressing the keys CTRL+V
7. Press the keys ALT+Q to exit the Editor, and return to Excel.
Code:
Option Explicit
Sub CopyRows()
Dim wsMain As Worksheet, wsWork As Worksheet, wsNew As Worksheet
Dim LR As Long, LRW As Long, LRN As Long, a As Long
Application.ScreenUpdating = False
Set wsMain = ActiveSheet
LR = wsMain.Range("C" & Rows.Count).End(xlUp).Row
Set wsWork = Worksheets.Add
wsMain.Range("C2:C" & LR).Copy wsWork.Range("A1")
With wsWork
LRW = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A1:A" & LRW).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsWork.Range("B1"), Unique:=True
Range("A1").EntireColumn.Delete
Range("A1").EntireRow.Delete
LRW = .Range("A" & Rows.Count).End(xlUp).Row
End With
With wsMain
For a = 1 To LRW Step 1
On Error Resume Next
Sheets(wsWork.Range("A" & a).Value).Select
If Err Then Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = wsWork.Range("A" & a).Value
On Error GoTo 0
Set wsNew = ActiveSheet
LRN = wsNew.Range("C" & Rows.Count).End(xlUp).Row
With .Range("B2:M" & LR)
.AutoFilter
.AutoFilter Field:=2, Criteria1:=wsWork.Range("A" & a).Value, Operator:=xlAnd
.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy wsNew.Range("A" & LRN + 1)
.AutoFilter
End With
Next a
End With
Application.DisplayAlerts = False
wsWork.Delete
Application.DisplayAlerts = True
wsMain.Select
Application.ScreenUpdating = True
End Sub
Then run the "CopyRows" macro.
Each time you run the macro, the data will be coped to the respective sheets.
Have a great day,
Stan
Add new worksheet
