I have data in columns in one worksheet

each set has two columns separated by a blank column

I wish to copy both columns of each set onto a new worksheet (renamed
with Row 1 name)


A B C D E F G H more data
accross
1 XX YY ZZ
2 Y 91 A 5 D 55
3 Z 92 B 6 E 66

columns C, F, I etc are blank - separating the data

i.e.
create new worksheet labelled "XX" with columns A and B pasted in A
and B
and new worksheet "YY" with columns D and E pasted in A and B
and new worksheet "ZZ" with columns G and H pasted in A and B

looping through all the data in the sheet (over 600 sets)


any help appreciated

thanks
Rob

Sub SplitData()

Set Oldsht = ActiveSheet
With Oldsht
LastCol = .Cells(2, Columns.Count).End(xlToLeft).Column
For Colcount = 1 To LastCol Step 3
Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
Label = .Cells(1, Colcount)
NewSht.Name = Label
LastRow = .Cells(Rows.Count, Colcount).End(xlUp).Row
.Range(.Cells(2, Colcount), .Cells(LastRow, Colcount + 1)).Copy _
Destination:=NewSht.Range("A1")
Next Colcount
End With
End Sub


"Rob P" wrote:

I have data in columns in one worksheet

each set has two columns separated by a blank column

I wish to copy both columns of each set onto a new worksheet (renamed
with Row 1 name)


A B C D E F G H more data
accross
1 XX YY ZZ
2 Y 91 A 5 D 55
3 Z 92 B 6 E 66

columns C, F, I etc are blank - separating the data

i.e.
create new worksheet labelled "XX" with columns A and B pasted in A
and B
and new worksheet "YY" with columns D and E pasted in A and B
and new worksheet "ZZ" with columns G and H pasted in A and B

looping through all the data in the sheet (over 600 sets)


any help appreciated

thanks
Rob

On Apr 15, 12:54*pm, joel wrote:
Sub SplitData()

Set Oldsht = ActiveSheet
With Oldsht
* *LastCol = .Cells(2, Columns.Count).End(xlToLeft).Column
* *For Colcount = 1 To LastCol Step 3
* * * Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
* * * Label = .Cells(1, Colcount)
* * * NewSht.Name = Label
* * * LastRow = .Cells(Rows.Count, Colcount).End(xlUp).Row
* * * .Range(.Cells(2, Colcount), .Cells(LastRow, Colcount + 1)).Copy _
* * * * *Destination:=NewSht.Range("A1")
* *Next Colcount
End With
End Sub



"Rob P" wrote:
I have data in columns in one worksheet

each set has two columns separated by a blank column

I wish to copy both columns of each set onto a new worksheet (renamed
with Row 1 name)

* * *A * * B * * C * * D * * E * * F * * G * * H * * * * * more data
accross
1 * XX * * * * * * * * *YY * * * * * * * * ZZ
2 * Y * * 91 * * * * * A * * *5 * * * * * D * * *55
3 * Z * * 92 * * * * * B * * * 6 * * * * * E * * *66

columns C, F, I etc are blank - separating the data

i.e.
create new worksheet labelled "XX" with columns A and B pasted in A
and B
and new worksheet "YY" with columns D and E pasted in A and B
and new worksheet "ZZ" with columns G and H pasted in A and B

looping through all the data in the sheet (over 600 sets)

any help appreciated

thanks
Rob- Hide quoted text -

- Show quoted text -

perfect - thank you Joel

(apologies did not realise my request was posted on two separate
sites?!?!)