View Single Post
  #7   Report Post  
Harlan Grove
 
Posts: n/a
Default

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