Help with Macro in Excel

I would like to split an excel file into multiple csv files and re-save them as the Original Filename +1 with auto Increment.
e.g
Maryland1.csv
Maryland2.csv
Maryland3.csv and so on...

And if there is any application that can do this automated. please let me know.
tunde4lifeAsked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
nutschConnect With a Mentor Commented:
How does this tweak help:

Sub Test()
  Dim wb As Workbook
  Dim ThisSheet As Worksheet
  Dim NumOfColumns As Integer
  Dim RangeToCopy As Range
  Dim RangeOfHeader As Range        'data (range) of header row
  Dim WorkbookCounter As Integer
  Dim RowsInFile                    'how many rows (incl. header) in new files?

  Application.ScreenUpdating = False

  'Initialize data
  Set ThisSheet = ThisWorkbook.ActiveSheet
  NumOfColumns = ThisSheet.UsedRange.Columns.Count
  WorkbookCounter = 1
  RowsInFile = 10000                   'as your example, just 10 rows per file

  'Copy the data of the first row (header)
  Set RangeOfHeader = ThisSheet.Range(ThisSheet.Cells(1, 1), ThisSheet.Cells(1, NumOfColumns))

  For p = 2 To ThisSheet.UsedRange.Rows.Count Step RowsInFile - 1
    Set wb = Workbooks.Add

    'Paste the header row in new file
    RangeOfHeader.Copy wb.Sheets(1).Range("A1")

    'Paste the chunk of rows for this file
    Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p + RowsInFile - 2, NumOfColumns))
    RangeToCopy.Copy wb.Sheets(1).Range("A2")

    'Save the new workbook, and close it
    wb.SaveAs ThisWorkbook.Path & "\Maryland" & WorkbookCounter & ".csv", FileFormat:=xlCSV
    wb.Close

    'Increment file counter
    WorkbookCounter = WorkbookCounter + 1
  Next p

  Application.ScreenUpdating = True
  Set wb = Nothing
End Sub
                                            

Open in new window

0
 
nutschCommented:
On what basis would you like it split? By worksheet, values within a list?
0
 
tunde4lifeAuthor Commented:
Splitting it based on numbers of rows. Here is what i have so far but it doesn't save it in the csv file format nor does it save the file using the current document name.

Sub Test()
  Dim wb As Workbook
  Dim ThisSheet As Worksheet
  Dim NumOfColumns As Integer
  Dim RangeToCopy As Range
  Dim RangeOfHeader As Range        'data (range) of header row
  Dim WorkbookCounter As Integer
  Dim RowsInFile                    'how many rows (incl. header) in new files?

  Application.ScreenUpdating = False

  'Initialize data
  Set ThisSheet = ThisWorkbook.ActiveSheet
  NumOfColumns = ThisSheet.UsedRange.Columns.Count
  WorkbookCounter = 1
  RowsInFile = 10000                   'as your example, just 10 rows per file

  'Copy the data of the first row (header)
  Set RangeOfHeader = ThisSheet.Range(ThisSheet.Cells(1, 1), ThisSheet.Cells(1, NumOfColumns))

  For p = 2 To ThisSheet.UsedRange.Rows.Count Step RowsInFile - 1
    Set wb = Workbooks.Add

    'Paste the header row in new file
    RangeOfHeader.Copy wb.Sheets(1).Range("A1")

    'Paste the chunk of rows for this file
    Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p + RowsInFile - 2, NumOfColumns))
    RangeToCopy.Copy wb.Sheets(1).Range("A2")

    'Save the new workbook, and close it
    wb.SaveAs ThisWorkbook.Path & "\Maryland" & WorkbookCounter
    wb.Close

    'Increment file counter
    WorkbookCounter = WorkbookCounter + 1
  Next p

  Application.ScreenUpdating = True
  Set wb = Nothing
End Sub

Open in new window

0
 
tunde4lifeAuthor Commented:
It works just perfectly thank you.
0
All Courses

From novice to tech pro — start learning today.