Copy data from an Excel sheet to different files

Question

I have an excel sheet which has some huge data. Data is organized as follows, A set of 7 columns and n rows; as in a table, and 1000s of such tables are placed horizontally with an empty column to separate. A screenshot is below..

enter image description here ...

I just want to have data of every 'table' saved into a different file. Manually it would take ever! So, Is there a macro or something I would automate this task with. I am not well versed with writing macros or any VBA stuff.

Thanks,

Do you mean that you want each 'table' saved into it's own file, or all of them into the same file? — lnafziger
Yeah, I want each table saved to its own file. Sorry, I wasn't clear on that. — ViV
When you say "its own file" do you mean in a separate Excel spreadsheet, or do you want to save the data in some other format (CSV for example)? — assylias
I had to correct a typo in the middle of the previous version of this comment. You say each table is seven columns wide. Does that mean columns A and B are not to be saved? From the use of "n", I assume the tables are all different heights. If the table starting at C1 finishes on row 21, does the next table start at C23? If the table starting at K1 finishes on row 15, does the next table start at K17 or K23? What are the 1000s of files to be named? Will system generated names (F0001, F0002, F0003, etc) be acceptable? I do not think this is a difficult task but you must specify it fully. — Tony Dallimore
@assylias CSV preferable, but an Excel Spreadsheet will also do :) — ViV

Siddharth Rout Siddharth Rout · Accepted Answer · 2012-03-21T11:06:29

Tony has a valid point when he says

If the table starting at C1 finishes on row 21, does the next table start at C23? If the table starting at K1 finishes on row 15, does the next table start at K17 or K23?

So here is a code which will work in any condition i.e data is set horizontally or vertically.

DATA SNAPSHOT

enter image description here

CODE

'~~> Change this to the relevant Output folder
Const FilePath As String = "C:\Temp\"

Dim FileNumb As Long

Sub Sample()
    Dim Rng As Range
    Dim AddrToCopy() As String
    Dim i As Long

    On Error GoTo Whoa

    Application.ScreenUpdating = False

    Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, xlTextValues)

    If Not Rng Is Nothing Then
        AddrToCopy = Split(Rng.Address, ",")

        FileNumb = 1

        For i = LBound(AddrToCopy) To UBound(AddrToCopy)
            ExportToSheet (AddrToCopy(i))
        Next i
    End If

    MsgBox "Export Done Successfully"

LetsContinue:
    Application.ScreenUpdating = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Sub ExportToSheet(rngAddr As String)
    Range(rngAddr).Copy

    Workbooks.Add
    ActiveSheet.Paste

    ActiveWorkbook.SaveAs Filename:= _
    FilePath & "Output" & FileNumb & ".csv" _
    , FileFormat:=xlCSV, CreateBackup:=False

    Application.DisplayAlerts = False
    ActiveWorkbook.Close
    Application.DisplayAlerts = True

    FileNumb = FileNumb + 1
End Sub

NOTE: The above code will work for cells with only Text Values. For cells with only Numeric Values you have to use

Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, xlNumbers)

And for AlphaNumeric Values (As in your question above), use this

Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)

HTH

Sid

Copy data from an Excel sheet to different files

3 Answers