Hi,

Am Thu, 24 Oct 2013 11:35:53 -0700 (PDT) schrieb excelnoob:

I have a sorting issue I hope someone can assist with. I have a ?roll up? sheet that combines data from numerous tabs. All the tabs have the exact same headers as well as the roll up. The header range is A18:Z18 and the data starts directly below in row 19. The header in column E (called Job#) is what I need to sort by. There are numerous job numbers and are not in any particular order.

I am in need of a macro that will search the Job# column, find all the rows with that specific job number, insert a new sheet, rename the sheet the "Job" and job number, and then populate the headers and the cell references (not copy, since I need to keep the references to the roll up). It would also be good if the macro could sort by the names in column A, but is not necessary.

For example, in the ?roll up? there are 100 rows with 20 unique job numbers (column E). Job number 5555 shows up 30 times in the table with no real pattern. I would like the macro to find all 30 rows for job 5555, then open a new tab, rename the tab ?Job 5555? and populate the tab with the all the headers (and in row 18 as well) and the cell references from the master directly below the headers. Once complete, it moves on to the next job number and repeats until all unique job numbers have their own sheets.

try:

Sub Test()
Dim LRow As Long
Dim LrowT As Long
Dim rngC As Range
Dim varFilter() As Variant
Dim i As Integer

Application.ScreenUpdating = False
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Temp"
With Sheets("RollUp")
LRow = .Cells(Rows.Count, "E").End(xlUp).Row
.Range("E18:E" & LRow).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("A1"), Unique:=True

LrowT = Sheets("Temp").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LrowT
ReDim Preserve varFilter(LrowT - 2)
varFilter(i - 2) = Sheets("Temp").Cells(i, 1)
Next

With .Range("A18:Z" & LRow)
For i = LBound(varFilter) To UBound(varFilter)
.AutoFilter field:=5, Criteria1:=varFilter(i)
.Copy
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Job " & varFilter(i)
[A18].Select
ActiveSheet.Paste link:=True
ActiveSheet.UsedRange.Sort key1:=Range("A18"), _
Order1:=xlAscending, Header:=xlYes
Next
End With
..AutoFilterMode = False
End With
Application.DisplayAlerts = False
Sheets("Temp").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2