Need Assistance with VBA code for Splitting Out Rows

[MaizeandBlue]

Hello,

I have read through multiple VBA codes for splitting out row data on a worksheet. What I am specifically trying to do is as follows:

Split out data for every 15 rows of information into their own worksheets.

I want to keep Row and Column widths based on the master sheet.

The master sheet has the first row as a header, and I would like to have that header copy to each sheet.

I found the below code, that split out the rows correctly, but I could not get widths or the header to carry over. All help is greatly greatly greatly appreciated.

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



Thanks,
Maize

 

[DanteAmor]

Hi and welcome to MrExcel.

Let's try another approach, try this:

Sub SplitData()
  Dim sh As Worksheet, i As Long
  Application.ScreenUpdating = False
  Set sh = Sheets("Master")
  For i = 2 To sh.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row Step 15
    sh.Copy , Sheets(Sheets.Count)
    ActiveSheet.Rows("2:" & Rows.Count).ClearContents
    sh.Rows(i & ":" & i + 14).Copy
    ActiveSheet.Range("A2").PasteSpecial xlPasteValues
  Next
End Sub

 

[MaizeandBlue]

Hi and welcome to MrExcel.

Let's try another approach, try this:

Sub SplitData()
  Dim sh As Worksheet, i As Long
  Application.ScreenUpdating = False
  Set sh = Sheets("Master")
  For i = 2 To sh.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row Step 15
    sh.Copy , Sheets(Sheets.Count)
    ActiveSheet.Rows("2:" & Rows.Count).ClearContents
    sh.Rows(i & ":" & i + 14).Copy
    ActiveSheet.Range("A2").PasteSpecial xlPasteValues
  Next
End Sub

Dante,

Thank you sooooooo much!!! That was perfect and I couldn't have asked for more! Again, thank you thank you thank you!!!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.