Hi
See how this goes
Sub aaa()
Dim OutSH As Worksheet, DataSH As Worksheet
Set DataSH = Sheets("Sheet1")
DataSH.Activate
Range("F1").Value = Range("A1").Value
Cells(Rows.Count, 1).End(xlUp).Select
If Left(ActiveCell, 6) = "Totals" Then ActiveCell.Resize(1, 4).ClearContents
Range("A1").Select
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
Application.StatusBar = i
On Error Resume Next
Set OutSH = Nothing
Set OutSH = Sheets(CStr(Cells(i, 1).Value))
On Error GoTo 0
If OutSH Is Nothing Then
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = DataSH.Cells(i, 1).Value
ActiveSheet.Range("A1:D1").Value = DataSH.Range("A1:D1").Value
DataSH.Activate
Range("F2").Value = Cells(i, 1).Value
Range("A:D").AdvancedFilter Action:=xlFilterCopy, criteriarange:=Range("F1:F2"), copytorange:=Sheets(CStr(Cells(i, 1).Value)).Range("A1:D1")
End If
Next i
DataSH.Activate
Application.StatusBar = False
Range("F1:F2").ClearContents
End Sub
rylo
Bookmarks