Harlan,
This is a good script, thank you. I am having a little trouble with it
sorting all of my columns and objects so I was rethinking it might be easier
to have a macro copy every row/column containing data and objects in each of
my sheets and copy it to a new sheet. Then I can just use the Sort function
on the particular column (containing the reference number) on that sheet
containing all the data. Would you know of a macro that would do that? It
would have to determine the number of rows in each of the worksheets, as they
are all different (and are added and subtracted to regularly). They all have
the same number and order of columns though. Thanks.


"Harlan Grove" wrote:

Phil wrote...
Is there an easy way to do that, I have twenty tabs and the sheets have
header sections throughout? A macro perhaps?
....


Select the worksheets as a group, then select the common range to sort,
then run the following macro.


Sub smws()
Dim wsc As Sheets, r As Range, xr As Range
Dim i As Long, k As Long, n As Long, ra As String

If Not TypeOf Selection Is Range Then
MsgBox Prompt:="No range selected", Title:="smws - Halted"
Exit Sub
End If

Set wsc = ActiveWindow.SelectedSheets
Set r = Selection
ra = r.Address

If wsc.Count 1 Then
k = r.Rows.Count
n = k * wsc.Count

If n Rows.Count - r.Row + 1 Then
MsgBox Prompt:="Too many records to sort", Title:="smws - Halted"
Exit Sub
End If

Set xr = r.Offset(k, 0).Resize(n - k, r.Columns.Count)

If WorksheetFunction.CountA(xr) 0 Then
MsgBox Prompt:="Insufficient free cells", Title:="smws - Halted"
Exit Sub
End If

Application.ScreenUpdating = False
Application.EnableEvents = False
wsc(1).Select
For i = 2 To wsc.Count
wsc(i).Range(ra).Copy _
Destination:=r.Offset((i - 1) * k, 0).Cells(1, 1)
Next i
Union(r, xr).Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End If

Application.Dialogs(xlDialogSort).Show

If wsc.Count 1 Then
Application.ScreenUpdating = False
Application.EnableEvents = False
For i = 2 To wsc.Count
r.Offset((i - 1) * k, 0).Copy _
Destination:=wsc(i).Range(ra)
Next i
xr.Clear
wsc.Select
r.Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub