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

Question

我有一个 Excel 工作表，其中包含大量数据。数据组织如下，一组 7 列 n 行；就像在一个表格中一样，并且有数千个这样的表格水平放置，并用一个空列来分隔。屏幕截图如下..

...

我只想将每个“表”的数据保存到不同的文件中。手动的话就需要永远!那么，是否有一个宏或其他东西可以让我自动执行此任务。我不太熟悉编写宏或任何 VBA 内容。

谢谢

Answer 1

托尼说的有道理

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?

所以这是一个可以在任何条件下工作的代码，即数据水平或垂直设置。

数据快照

代码

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

对于字母数字值(如上面的问题)，请使用此

Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)

HTH

席德