You've got to be more careful when you modify the code <vbg.

The original code just copied rows(1) as the header. You changed it to
rows(2). But you didn't change the start of the details from A2 to A3.

so maybe this would work better:

Option Explicit
Sub EOM()
Dim Wks As Worksheet
Dim DestCell As Range
Dim newWks As Worksheet
Dim HeadersAreDone As Boolean
Dim mySelectedSheets As Object
Dim myRngToCopy As Range

Set mySelectedSheets = ActiveWindow.SelectedSheets
ActiveWorkbook.Worksheets(1).Select

If mySelectedSheets.Count < 3 Then
MsgBox "Please Group exactly 3 sheets before you run this macro!"
Exit Sub
End If

Set newWks = Workbooks.Add(1).Worksheets(1)

HeadersAreDone = False

ActiveWorkbook.Unprotect

For Each Wks In mySelectedSheets
With Wks
If HeadersAreDone = True Then
'do nothing
Else
'for both rows 1 & 2, use .rows("1:2").copy _
'instead of the next line
.Rows(2).Copy _
Destination:=newWks.Range("a1")
HeadersAreDone = True
Set DestCell = newWks.Range("a2")
End If

.Unprotect Password:=""
.Range("a3", .Cells.SpecialCells(xlCellTypeLastCell)).Copy
DestCell.PasteSpecial Paste:=xlPasteValues
.Protect Password:=""

With newWks
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

End With
Next Wks

End Sub

And you're formatting the new worksheet??

With newwks
.Select 'just for the .zoom to work.
ActiveWindow.Zoom = 67
.Range("b:b,d:d,I:i").NumberFormat = "dd/mm/yy"
.Range("j:j").NumberFormat = "hh:mm AM/PM"
.UsedRange.Columns.AutoFit
'or
.Range("a:a,c:c,e:e,H:h,k:k").EntireColumn.AutoFit
With .Range("g:g")
.Replace What:=" /", Replacement:="/", _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
MatchCase:=False
End With

With .UsedRange
.Sort key1:=.Range("a1"), Order1:=xlAscending, _
Key2:=.Range("G1"), Order2:=xlAscending, _
Key3:=.Range("F2"), Order3:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End With
End With

But watch out for that last sort. This code is sorting from Row 1 (headers in
row 1).

You may want this (or a variation):

With .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell))
.Sort key1:=.Range("a1"), Order1:=xlAscending, _
Key2:=.Range("G1"), Order2:=xlAscending, _
Key3:=.Range("F2"), Order3:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End With

Use the last row that contains headers in that "A2" reference.

And finally, you may be able to use Ron de Bruin's EasyFilter addin:
http://www.rondebruin.nl/easyfilter.htm

Or you could steal some code from Debra Dalgleish's site:
http://www.contextures.com/excelfiles.html

Create New Sheets from Filtered List -- uses an Advanced Filter to create
separate sheet of orders for each sales rep visible in a filtered list; macro
automates the filter. AdvFilterRepFiltered.xls 35 kb

Update Sheets from Master -- uses an Advanced Filter to send data from
Master sheet to individual worksheets -- replaces old data with current.
AdvFilterCity.xls 55 kb



Pank Mehta wrote:

Dave,

Firstly, many thanks for your time, patient and perseverance. I created a
macro name called EOM (as opposed to ALT+11 ) and it worked.

However, I have the following observation: -

The header row from each sheet (row 2) is copied into the new sheet, which I
dont want. (Can this be fixed?), if not I can delete them manually (rows 1 &
2 on all sheets are headers, data only commences in row 3 onwards. Basically
it puts 4 headers into the new sheet, I only want 1.

Secondly, I have created a macro to undertake some formatting and copied the
code into the macro code you provided and it works.

The code looks like:-

ActiveWindow.Zoom = 67
Columns("B:B").Select
Selection.NumberFormat = "dd/mm/yy"
Columns("D:D").Select
Selection.NumberFormat = "dd/mm/yy"
Columns("I:I").Select
Selection.NumberFormat = "dd/mm/yy"
Columns("J:J").Select
Selection.NumberFormat = "hh:mm AM/PM"
Columns("A:A").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("K:K").EntireColumn.AutoFit
Columns("G:G").Select
Selection.Replace What:=" /", Replacement:="/", LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=False
Cells.Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
Key2:=Range("G2") _
, Order2:=xlAscending, Key3:=Range("F2"), Order3:=xlAscending,
Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Is there a way to make this code more efficient, as I have been lead to
believe that you dont necessarily have to do the selects?

Lastly, the contents of the new sheet are as follows in column A:-

Company A
Company A
Company B
Company B
Company B
Company C
Company C
Company C
Company E
Company E

Etc.

Is there any way that I can automatically get a sheet set up for each
Company A, B, C, €¦with all data in to their corresponding sheets? Including a
header?

i.e. From the example above:-

Sheet called Company A with data for 2 rows into the sheet plus header at
the top
Sheet called Company B with data for 3 rows into the sheet plus header at
the top
Sheet called Company C with data for 3 rows into the sheet plus header at
the top
Sheet called Company E with data for 2 rows into the sheet plus header at
the top

Once again a ver big thank you.
<<snipped