VBA to show title row in all sheet

[adeel1]

hello all
i need little change in below VBA that when i run macro,the title row is showing only first sheet and i want title row in all sheets which i splitted..

Sub SplitData()
'Updateby20140617
Dim WorkRng As Range
Dim xRow As Range
Dim SplitRow As Integer
Dim xWs As Worksheet
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
SplitRow = Application.InputBox("Split Row Num", xTitleId, 5, Type:=1)
Set xWs = WorkRng.Parent
Set xRow = WorkRng.Rows(1)
Application.ScreenUpdating = False
For i = 1 To WorkRng.Rows.Count Step SplitRow
resizeCount = SplitRow
If (WorkRng.Rows.Count - xRow.Row + 1) < SplitRow Then resizeCount = WorkRng.Rows.Count - xRow.Row + 1
xRow.Resize(resizeCount).Copy
Application.Worksheets.Add after:=Application.Worksheets(Application.Worksheets.Count)
Application.ActiveSheet.Range("A1").PasteSpecial
Set xRow = xRow.Offset(SplitRow)
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[Chihiro]

Try this.

Sub SplitData()
'Updateby20140617
Dim WorkRng As Range
Dim xRow As Range
Dim SplitRow As Integer
Dim xWs As Worksheet
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
SplitRow = Application.InputBox("Split Row Num", xTitleId, 5, Type:=1)
Set xWs = WorkRng.Parent
'xRow to start exluding Header Row
Set xRow = WorkRng.Rows(2)
Application.ScreenUpdating = False
For i = 1 To WorkRng.Rows.Count Step SplitRow
    resizeCount = SplitRow
    If (WorkRng.Rows.Count - xRow.Row + 1) < SplitRow Then resizeCount = WorkRng.Rows.Count - xRow.Row + 1
    'combine Header Row & Split rows and copy
    Union(WorkRng.Rows(1), xRow.Resize(resizeCount)).Copy
    Application.Worksheets.Add after:=Application.Worksheets(Application.Worksheets.Count)
    Application.ActiveSheet.Range("A1").PasteSpecial
    Set xRow = xRow.Offset(SplitRow)
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[adeel1]

Dear Chihiro

bundle of thnx for help its working but need one little change in it splitted columns specially 'A' format is not like original sheet.,pl amend
Adeel

 

[Chihiro]

Just adjust column width to autofit contents.

 

[adeel1]

dear chihiro

there is no other way for it because for each sheet this is much lengthy work for me because this is only sample data

adeel

 

[Chihiro]

Stick this code just below ".PasteSpecial" line of the code.

    Application.ActiveSheet.Columns.AutoFit

 

[adeel1]

dear sir chihiro

lots of thnx, after couple of days finally you have solved my problem..great full to you

Adeel