Problems splitting a single worksheet into several sheets

[KR1978]

Hi

I've got a single worksheet which has several rows of data, each owned by an individual in row A, which I want to copy into separate sheets in the same workbook and call the sheets the individuals name.

The code below works except it copies the 1st row of data (in row A2) as the header for each sheet instead of the actual header (in row A1) itself.

Any ideas?

Private Sub CommandButton1_Click()
Dim wsData As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim rngCrit As Range
Dim LastRowData As Long
Set wsData = ActiveSheet
Set wsCrit = Worksheets.Add

LastRowData = wsData.Range("A" & Rows.Count).End(xlUp).Row
wsData.Range("A2:A" & LastRowData).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True

Set rngCrit = wsCrit.Range("A2")
While rngCrit.Value <> ""
Set wsNew = Worksheets.Add
wsNew.Name = rngCrit
wsData.Range("A2:K" & LastRowData).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCrit.Offset(-1).Resize(2), CopyToRange:=wsNew.Range("A1"), Unique:=True
rngCrit.EntireRow.Delete
Set rngCrit = wsCrit.Range("A2")
Wend

Application.DisplayAlerts = False
wsCrit.Delete

Columns.AutoFit

ActiveWorkbook.SaveAs Filename:="H:\My Documents\macros\" & test & "Members.xls"
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub

 

[Norie]

Try changing A2 to A1 for the data range.

wsData.Range("A1:A" & LastRowData).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True

I don't why it would have been A2, where did you find the code?

The only reason I can think of it being A2 would be if someone wanted code to work with data where the headers where in row 2.

 

[KR1978]

Thanks

I tried that but I think I must need to change something else because all I get then is the A2 row of data in every sheet...

 

[KR1978]

Got it - I needed to change the other 'wsData.Range("A1:A" & LastRowData)' reference too...

I got the code from another file used in our company created by someone else....

Thanks for your help.... just need to copy the sheets to separate files and email them to individual email addresses listed now...

 

[Norie]

Do you mean the "A2:AK" & LastRowData reference?

The good actually looks quite familiar.:wink:

I couldn't find a specific example where somebody asked for code for headers in row 2 though - the closest was row 5 headers.