Sub x()
Dim rng As Range, ws As Worksheet
Application.DisplayAlerts = False
With Sheet1
Sheets.Add().Name = "temp"
.Range("A1", .Range("A" & Rows.Count).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("temp").Range("A1"), Unique:=True
For Each rng In Sheets("temp").Range("A2", Sheets("temp").Range("A2").End(xlDown))
If UCase(Right(rng, 5)) <> "TOTAL" Then
Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
ws.Name = rng
.AutoFilterMode = False
.Range("A1").AutoFilter field:=1, Criteria1:=rng & "*"
.AutoFilter.Range.Copy Sheets(rng.Text).Range("A1")
Sheets(rng.Text).Move
ActiveWorkbook.Close SaveChanges:=True, Filename:="C:\Users\Stephen\Desktop\" & rng & ".xls"
End If
Next rng
.AutoFilterMode = False
Sheets("temp").Delete
End With
Application.DisplayAlerts = True
End Sub
|