Splitting a large Worksheet into multiple work books after n rows while keeping the header row

[Zaher503]

I have a large dataset of only 3 columns. I want this set to be split every x rows into a separate excel file, or workbook. I also want the header row to remain the same in all files.
If you want a sample of what I am looking for I can provide some screenshots.

I have looked everywhere without a solution so any help would be great.

 

[Marc L]

​

1- How would you customize the x factor except to amend the VBA procedure ?​

​

5 : Is it always the same original text filename in the same original directory (in that case I need the full path)​

or need to choose the file each time you launch the VBA procedure ?​

 

[Zaher503]

​

1- How would you customize the x factor except to amend the VBA procedure ?​

​

5 : Is it always the same original text filename in the same original directory (in that case I need the full path)​

or need to choose the file each time you launch the VBA procedure ?​

1- If you show me where in the code that number is I can edit it myself for each file. Or maybe a pop up that asks you how many lines you want this time? It doesn't matter really.

5- It will be the same filename every time. to make things easier I will rename every file I want to use this code on to split.xlsx

Regarding the path it is going to be on my desktop. Here is the path:
C:\Users\Zaher\Desktop\Work Docs

 

[Marc L]

​

So the full path should be every time C:\Users\Zaher\Desktop\Work Docs\Sample.csv ?​

 

[Zaher503]

​

So the full path should be every time C:\Users\Zaher\Desktop\Work Docs\Sample.csv ?​

exactly

 

[Marc L]

Ok, now I have enough material to give it a try, as a reminder for your next thread …​

 

[Marc L]

According to your attachment a VBA demonstration for starters :​

Sub Demo1()
   Const D="C:\Users\Zaher\Desktop\Work Docs\", F="Sample.csv", P = D & "Output\"
     Dim M&, Ws As Worksheet, R&, N&
         If Dir(D & F) = "" Then Beep: Exit Sub
         If Dir(P, 16) = "" Then MkDir P
    With Application
      Do
         M = .InputBox("Max rows # ?", "Split csv to xlsx", 100, , , , , 1) - 1
         If M = -1 Then Exit Sub Else If M < 1 Then Beep
      Loop Until M > 0
        .DisplayAlerts = False
        .ScreenUpdating = False
        .SheetsInNewWorkbook = 1
         Set Ws = Workbooks.Add.Sheets(1)
    With Workbooks.Open(D & F, , , 2).Sheets(1).UsedRange.Rows
           .Item(1).Copy Ws.[A1]
        For R = 2 To .Count Step M
            N = N + 1
            Application.StatusBar = "       Workbook #" & N
           .Item(R).Resize(M).Copy Ws.[A2]
            Ws.Columns.AutoFit
            Ws.Parent.SaveAs P & Format(N, "000"), 51
            If N Mod 6 = 0 Then DoEvents
        Next
           .Parent.Parent.Close
    End With
        Ws.Parent.Close
        Set Ws = Nothing
       .DisplayAlerts = True
       .ScreenUpdating = True
       .StatusBar = False
    End With
        MsgBox N & " workbooks saved", 64, "Done"
End Sub