Divide Database Into Smaller Files with 200 lines each

[Gamermatt]

Hello,

I have a very large database, and I need to divide it into smaller files of 200 lines each. So, every 200 lines there should be a new file saved. Is there a way to automate this, and save each smaller database as a csv file? The names can just be 1.csv, 2.csv, etc.

Matt

 

[Darren Bartrup]

This should do the trick, remember to change the file path in the SaveAs and the total rows in the Do Until lRow >= 1197 bit.

Sub Test()
    Dim wrkBk As Workbook, wrkSht As Worksheet
    Dim lNumber As Long
    Dim lRow As Long
    
    lRow = 1
    lNumber = 1
    
    Application.DisplayAlerts = False
    
    Do Until lRow >= 1197
        Set wrkBk = Workbooks.Add
        With wrkBk
            Set wrkSht = .Worksheets.Add
            wrkSht.Name = lRow & " to " & lRow + 199
            ThisWorkbook.Worksheets("Sheet1").Rows(lRow & ":" & lRow + 199).Copy Destination:=wrkSht.Range("A1")
            .SaveAs "D:\Documents and Settings\My Documents\" & lNumber, xlCSV
            .Close
            lRow = lRow + 200
            lNumber = lNumber + 1
        End With
    Loop

    Application.DisplayAlerts = False
    
End Sub

 

[Gamermatt]

This should do the trick, remember to change the file path in the SaveAs and the total rows in the Do Until lRow >= 1197 bit.

Sub Test()
    Dim wrkBk As Workbook, wrkSht As Worksheet
    Dim lNumber As Long
    Dim lRow As Long
    
    lRow = 1
    lNumber = 1
    
    Application.DisplayAlerts = False
    
    Do Until lRow >= 1197
        Set wrkBk = Workbooks.Add
        With wrkBk
            Set wrkSht = .Worksheets.Add
            wrkSht.Name = lRow & " to " & lRow + 199
            ThisWorkbook.Worksheets("Sheet1").Rows(lRow & ":" & lRow + 199).Copy Destination:=wrkSht.Range("A1")
            .SaveAs "D:\Documents and Settings\My Documents\" & lNumber, xlCSV
            .Close
            lRow = lRow + 200
            lNumber = lNumber + 1
        End With
    Loop

    Application.DisplayAlerts = False
    
End Sub

Thank you!

 

[Darren Bartrup]

No probs.

Just noticed something tho - the last

Application.DisplayAlerts = False

should be

Application.DisplayAlerts = True

DisplayAlerts allows it to overwrite any existing files of that name without giving a warning message, so you may want to omit those lines.