Split one worksheet to multiple

[Carolina Girl]

Can anyone help??? I have been tasked to write a macro that will take one
worksheet and split it up into multiple sheets. I have found wonderful
information if the cells split information was in the came column but my
issue comes in when I have multiple rows… i.e this is how I need it split by
what is x’ed) I need all the worksheet to have row A1 (headers), first
worksheet (CD) should have all the information for B2 and B3 worksheet two
(FA) should have B2 and B4 etc….
A B C D
1 Name CD FA RA
2 Fun x x
3 Joy x x
4 Happy x x

Please help…. Thank you in advance.

 

[Thomas [PBD]]

Carolina Girl,

Here is a macro for you to try out. Seems that it does what it needs to do
when I run it in my test environment with your example below.

Sub sub_1()

Dim Rng1 As String
Dim ShtCt As Long
Dim Rngrw As Long
Dim Rngcl As Long

Rng1 = "SetRange" 'change if necessary
ShtCt = ActiveWorkbook.Sheets.Count
Rngrw = Range(Rng1).Rows.Count
Rngcl = Range(Rng1).Columns.Count

For x = 2 To Rngcl
Dim shtnme As String
shtnme = Range(Rng1).Cells(1, x).Value
Sheets.Add
Sheets("Sheet" & ShtCt + x - 1).Name = shtnme
Sheets(shtnme).Range("A1").Value = Range(Rng1).Cells(1, 1).Value
For i = 2 To Rngrw
Dim CellVal As String
If Range(Rng1).Cells(i, x).Value <> "" Then
CellVal = Range(Rng1).Cells(i, 1).Value
Sheets(shtnme).Select

Range("A1").Cells(Excel.WorksheetFunction.CountA(Sheets(shtnme).Columns("A:A")) + 1, 1).Value = CellVal
End If
Next
Next

End Sub