'Modification of Tom Ogilvy's ABC
Sub ABC()
Dim rw As Long, i As Long
Dim cell As Range
Dim sh As Worksheet

For Each sh In ActiveWorkbook.Worksheets
If sh.Name < "Sheet1" Then
sh.Cells.Sort Key1:=sh.Range("B1"), Header:=xlNo
rw = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row
sh.Columns(1).Insert
For i = rw To 2 Step -1
Set cell = sh.Cells(i, 3)
If
Application.WorksheetFunction.CountA(cell.EntireRo w.Cells) = 0 Then
sh.Rows(i).Delete
Set cell = sh.Cells(i, 3)
End If
If cell < cell.Offset(-1, 0) Then
sh.Rows(i).Insert
sh.Cells(i, 1) = sh.Cells(i + 1, 3)
If sh.Cells(i, 1) = "" Then sh.Cells(i, 1) = "No Lead"
End If
Next
sh.Rows(1).Insert
sh.Cells(1, 1) = sh.Cells(2, 3)
End If
Next sh
End Sub


--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)
"Sjakkie" wrote in message
...
thanks to tom and jason for the script below.
One last question though. How could i get this to process the macro
through
the worksheet and then go to the next one and keep doing this, But To
exclude
the worksheet named "sheet1". When i try to do a loop it does it all in
the
same worksheet......




'Modification of Tom Ogilvy's ABC
Sub ABC()
Dim rw As Long, i As Long
Dim cell As Range
Cells.Sort Key1:=Range("B1"), Header:=xlNo
rw = Cells(Rows.Count, 1).End(xlUp).Row
Columns(1).Insert
For i = rw To 2 Step -1
Set cell = Cells(i, 3)
If Application.WorksheetFunction.CountA(cell.EntireRo w.Cells) = 0
Then
Rows(i).Delete
Set cell = Cells(i, 3)
End If
If cell < cell.Offset(-1, 0) Then
Rows(i).Insert
Cells(i, 1) = Cells(i + 1, 3)
If Cells(i, 1) = "" Then
Cells(i, 1) = "No Lead"
End If
End If
Next
Rows(1).Insert
Cells(1, 1) = Cells(2, 3)
End Sub