Auto spliting Macro script

[stonetod]

Hi Everyone,

I have copied a code online to split my excel by colmun F.
However it only created header on one specific row now, but my required hearder is row 1-4.
Please kindly help to solve ( i just started self-taught and got no idea how to code so far)

Thanks!


Sub SplitData()
Const NameCol = "F"
Const HeaderRow = 4
Const FirstRow = 5
Dim SrcSheet As Worksheet
Dim TrgSheet As Worksheet
Dim SrcRow As Long
Dim LastRow As Long
Dim TrgRow As Long
Dim Student As String
Application.ScreenUpdating = False
Set SrcSheet = ActiveSheet
LastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).Row
For SrcRow = FirstRow To LastRow
Student = SrcSheet.Cells(SrcRow, NameCol).Value
Set TrgSheet = Nothing
On Error Resume Next
Set TrgSheet = Worksheets(Student)
On Error GoTo 0
If TrgSheet Is Nothing Then
Set TrgSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
TrgSheet.Name = Student
SrcSheet.Rows(HeaderRow).Copy Destination:=TrgSheet.Rows(HeaderRow)
End If
TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).Row + 1
SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
Next SrcRow
Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

Please tell me in words what your wanting to do.
I do not like trying to read code that does not work and try to get it to do what you want when you have not explained what you want to do.

All you have actually told me is you want to:
Split column F
I do not understand what that means

 

[stonetod]

Sorry my bad... ( my post seems not apper? retype again)

My work need to split the excel to seperate sheet by data on colmun F.
The code works fine, however it can only copy row 4 as header, instead of the original report using row 1-4.

Hope this picture could be shown.
Thanks!

 

[stonetod]

 

[My Aswer Is This]

Are you saying if column F of row 2 says "David" you want this row copied to sheet named "David"
And if column F of row 3 says "Mark" you want this row copied to sheet named Mark

Have all these sheets already been created?

 

[stonetod]

ya exactly!
these sheets could be created with row 4 as header
Now wanted to edit it to copy row 1-4 as header, is it possible? THANKS@!

 

[My Aswer Is This]

Try this:

Sub SplitData()
'Modified 4-18-18 12:35 AM EDT
Const NameCol = "F"
'Const HeaderRow = 4  Modified
Const HeaderRow = 1
Const FirstRow = 5
Dim SrcSheet As Worksheet
Dim TrgSheet As Worksheet
Dim SrcRow As Long
Dim LastRow As Long
Dim TrgRow As Long
Dim Student As String
Application.ScreenUpdating = False
Set SrcSheet = ActiveSheet
LastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).Row
For SrcRow = FirstRow To LastRow
Student = SrcSheet.Cells(SrcRow, NameCol).Value
Set TrgSheet = Nothing
On Error Resume Next
Set TrgSheet = Worksheets(Student)
On Error GoTo 0
If TrgSheet Is Nothing Then
Set TrgSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
TrgSheet.Name = Student
'SrcSheet.Rows(HeaderRow).Copy Destination:=TrgSheet.Rows(HeaderRow) Modified
SrcSheet.Rows("1:4").Copy Destination:=TrgSheet.Rows(1)
End If
TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).Row + 1
SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
Next SrcRow
Application.ScreenUpdating = True
End Sub

 

[stonetod]

Thanks! It works perfectly!

'Const HeaderRow = 4

 

[My Aswer Is This]

Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.

Thanks! It works perfectly!

'Const HeaderRow = 4