0

I'm searching for a macro to take an excel file of several rows and split the sheet's rows up into sheets of any amount of rows we desire per-sheet, including the original rows, which should also be copied to each sheet. In simple if i have a file with row

1
2
3

then that macro split the rows make a sheet with .csv file like these so we get a 3 file form above

file1   file2   file3
  1         1       1
            2       2
                    3 

i hope you get the point i searched for it but only able to find

Option Explicit

Sub SplitWorkbooksByNrows()
'Jerry Beaucaire,  2/28/2012
'Split all data sheets in a folder by a variable number or rows per sheet, optional titles
'assumes only one worksheet of data per workbook
Dim N As Long, rw As Long, LR As Long, Cnt As Long, Cols As String, Titles As Boolean
Dim srcPATH As String, destPATH As String, fNAME As String, wbDATA As Workbook, titleRNG As Range

srcPATH = "C:\Path\To\Source\Files\"            'remember the final \ in this string
destPATH = "C:\Path\To\Save\NewFiles\"          'remember the final \ in this string
                                                'determine how many rows per sheet to create
    N = Application.InputBox("How many rows per sheet?", "N-Rows", 50, Type:=1)
    If N = 0 Then Exit Sub                      'exit if user clicks CANCEL
                                                'Examples of usable ranges:  A:A    A:Z   C:E   F:F
    Cols = Application.InputBox("Enter the Range of columns to copy", "Columns", "A:Z", Type:=2)
    If Cols = "False" Then Exit Sub             'exit if user clicks CANCEL
                                                'prompt to repeat row1 titles on each created sheet
    If MsgBox("Include the title row1 on each new sheet?", vbYesNo, _
                "Titles?") = vbYes Then Titles = True

    Application.ScreenUpdating = False          'speed up macro execution
    Application.DisplayAlerts = False           'turn off system alert messages, use default answers
    fNAME = Dir(srcPATH & "*.xlsx")             'get first filename from srcPATH

    Do While Len(fNAME) > 0                     'exit loop when no more files found
        Set wbDATA = Workbooks.Open(srcPATH & fNAME)        'open found file
        With ActiveSheet
            LR = Intersect(.Range(Cols), .UsedRange).Rows.Count             'how many rows of data?
            If Titles Then Set titleRNG = Intersect(.Range(Cols), .Rows(1)) 'set title range, opt.
            For rw = 1 + ---Titles To LR Step N 'loop in groups of N rows
                Cnt = Cnt + 1                   'increment the sheet creation counter
                Sheets.Add                      'create the new sheet
                If Titles Then titleRNG.Copy Range("A1")    'optionally add the titles
                                                'copy N rows of data to new sheet
                Intersect(.Range("A" & rw).Resize(N).EntireRow, .Range(Cols)).Copy Range("A1").Offset(Titles)
                ActiveSheet.Columns.AutoFit     'cleanup
                ActiveSheet.Move                'move created sheet to new workbook
                                                'save with incremented filename in the destPATH
                ActiveWorkbook.SaveAs destPATH & "Datafile_" & Format(Cnt, "00000") & ".xlsx", xlNormal
                ActiveWorkbook.Close False      'close the created workbook
            Next rw                             'repeat with next set of rows
        End With
        wbDATA.Close False                      'close source data workbook

        fNAME = Dir                             'get next filename from the srcPATH
    Loop                                        'repeat for each found file

    Application.ScreenUpdating = True           'return to normal speed
    MsgBox "A total of " & Cnt & " data files were created."        'report
End Sub

Reference https://sites.google.com/a/madrocketscientist.com/jerrybeaucaires-excelassistant/parse-functions/rows What this macro is doing

if we have these rows
    1
    2
    3

Macro doing this

file1   file2   file3
  1         2       3   

The code which is provided do exactly what i wanted but only if the macro can add the rows to. Like this.

file1   file2   file3
  1         1       1
            2       2
                    3 
4
  • 1
    Try using the macro recorder to get a general idea of the code needed. As of right now it's hard to understand what you need and you don't seem to have tried to write any code...
    – ARich
    Sep 21, 2013 at 17:23
  • 2
    Questions asking for code must demonstrate a minimal understanding of the problem being solved. Include attempted solutions, why they didn't work, and the expected results. See also: Stack Overflow question checklist Sep 21, 2013 at 22:10
  • Take some time, and edit your question (and comment above) into understandable English. I fear you will simply be closed off otherwise. Sep 22, 2013 at 3:41
  • Ok have added more details for more understanding of the question. I think it will be clear now what i am asking for. Thanks Sep 22, 2013 at 4:31

1 Answer 1

1

This may help get you started. You'll need to put your own range references and filepaths etc.

Sub SplitAndSave()
    Dim rows As Long, rw As Long, myFolder As String, ws As Worksheet

    rows = Worksheets("Sheet1").Range("A1:A10").rows.Count
    myFolder = "C:\Users\Desktop\MyFolder\"
    Set ws = Worksheets("Sheet2")

    For rw = 1 To rows
        ws.Cells.ClearContents
        Range("A1:A" & rw).Copy Destination:=ws.Range("A1")
        ws.SaveAs myFolder & "file" & rw & ".csv", xlCSV
    Next rw
End Sub

This will split your data in Range(A1:A10) in to ten separate .csv files and place them in a folder called MyFolder on the desktop.

2
  • Macro worked You rock one thing more if we have 5 columns Than how we will do it. Sep 22, 2013 at 15:13
  • For five columns change to Range("A1:E" & rw).Copy...
    – Alex P
    Sep 22, 2013 at 17:21

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.