Split Column by name with headings

BritA

New Member
Joined
May 8, 2012
Messages
5
I found some code to split a column by data. What i can't figure out is how to add the heading to each of the tabs/new sheets created. I have included the coding I am currently using. Any ideas on what to add to make the heading of the original sheet carry over to the additional sheets?

Sub FanOut()
Dim ColHead As String
Dim ColHeadCell As Range
Dim iCol As Integer
Dim iRow As Long 'row index on Fan Data sheet
Dim lRow As Integer 'row index on individual destination sheet
Dim Dsheet As Worksheet 'destination worksheet
Dim Fsheet As Worksheet 'fan data worksheet (assumed active)
Again:
ColHead = "Empl Name"
If ColHead = "" Then Exit Sub
Set ColHeadCell = Rows(1).Find(ColHead, lookat:=xlWhole)
If ColHeadCell Is Nothing Then
MsgBox "Heading not found in row 1"
GoTo Again
End If

Set Fsheet = ActiveSheet
iCol = ColHeadCell.Column
'loop through values in selected column
For iRow = 2 To Fsheet.Cells(65536, iCol).End(xlUp).Row
If Not SheetExists(Fsheet.Cells(iRow, iCol).Value) Then
Set Dsheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))
Dsheet.Name = CStr(Fsheet.Cells(iRow, iCol).Value)
Else
Set Dsheet = Worksheets(Fsheet.Cells(iRow, iCol).Value)
End If
lRow = Dsheet.Cells(65536, iCol).End(xlUp).Row
Fsheet.Rows(iRow).Copy Destination:=Dsheet.Rows(lRow + 1)
Next iRow
End Sub
Function SheetExists(SheetId As Variant) As Boolean
' This function checks whether a sheet (can be a worksheet,
' chart sheet, dialog sheet, etc.) exists, and returns
' True if it exists, False otherwise. SheetId can be either
' a sheet name string or an integer number. For example:
' If SheetExists(3) Then Sheets(3).Delete
' deletes the third worksheet in the workbook, if it exists.
' Similarly,
' If SheetExists("Annual Budget") Then Sheets("Annual Budget").Delete
' deletes the sheet named "Annual Budget", if it exists.
Dim Sh As Object
On Error GoTo NoSuch
Set Sh = Sheets(SheetId)
SheetExists = True
Exit Function
NoSuch:
If Err = 9 Then SheetExists = False Else Stop
End Function



Thanks for any help!
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

Forum statistics

Threads
1,223,236
Messages
6,170,917
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top