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..

...

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,

Answer 1

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

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