将数据从Excel工作表复制到不同的文件

Question

我有一张excel表,里面有一些巨大的数据.数据组织如下,一组7列和n行; 如表中所示,1000个这样的表水平放置,空列分开.屏幕截图如下......

...

我只想将每个"表"的数据保存到不同的文件中.手动它需要永远!那么,是否有一个宏或其他什么我会自动执行此任务.我不熟悉编写宏或任何VBA的东西.

谢谢,

Answer 1

当他说时,托尼有一个有效的观点

如果从C1开始的表在第21行结束,那么下一个表是否从C23开始？如果从K1开始的表在第15行结束,那么下一个表是从K17还是K23开始的？

所以这里的代码可以在任何条件下工作,即水平或垂直设置数据.

数据快照

码

'~~> 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

注意:上面的代码适用于只有文本值的单元格.对于只有数字值的单元格,您必须使用

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

对于AlphaNumeric值(如上面的问题所述),请使用此选项

Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)

HTH

希德