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

【问题标题】：Copy data from an Excel sheet to different files将数据从 Excel 工作表复制到不同的文件
【发布时间】：2020-01-25 00:44:16
【问题描述】：

我有一个包含大量数据的 Excel 表格。数据组织如下，一组 7 列 n 行；就像在一个表中一样，将 1000 个这样的表水平放置，并用一个空列进行分隔。截图如下。。

...

我只想将每个“表”的数据保存到不同的文件中。手动将需要永远！那么，是否有一个宏或什么我可以自动执行此任务。我不擅长编写宏或任何 VBA 的东西。

谢谢，

【问题讨论】：

您的意思是要将每个“表”保存到它自己的文件中，还是将它们全部保存到同一个文件中？
是的，我希望每个表都保存到自己的文件中。抱歉，我不是很清楚。
当您说“它自己的文件”时，您是指在单独的 Excel 电子表格中，还是要将数据保存为其他格式（例如 CSV）？
我必须更正此评论先前版本中间的错字。你说每张桌子有七列宽。这是否意味着不保存 A 列和 B 列？从“n”的使用来看，我假设桌子都是不同的高度。如果从 C1 开始的表在第 21 行结束，那么下一个表是否从 C23 开始？如果从 K1 开始的表在第 15 行结束，那么下一个表是从 K17 还是 K23 开始？要命名的 1000 个文件是什么？系统生成的名称（F0001、F0002、F0003 等）是否可以接受？我不认为这是一项艰巨的任务，但您必须完全指定它。
@assylias CSV 更可取，但 Excel 电子表格也可以：)

标签： excel vba excel-2007

【解决方案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 Values（如您上面的问题），使用这个

Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)

HTH

席德

【讨论】：

正中目标！！谢谢。我正在尝试将文件名从“Output.csv”更改为表格的单元格（1,1），例如 AAPL.csv。你能给我一些指示吗？我正在尝试类似temp = Range.Cells(1, 1) 并使用 temp 文件名，但显然这里有问题，因为它说“Argument Not optional”。
temp = Range(rngAdr).Cells(1,1) 和 ActiveWorkbook.SaveAs Filename:= _ FilePath & temp & ".csv" _ , FileFormat:=xlCSV, CreateBackup:=False 应该做你想做的事。
@Vishruth：希望 assylias 的帖子能回答你的问题？

【解决方案2】：

只要任何数据集周围有一个空白行和一个空白列，这将使用 AREAS() 方法将它们全部放在单独的工作簿中。

按照前面的例子，它保存为 CSV，但当然你可以随意保存。

Option Explicit

Sub ExportDataGroups()
Dim fPATH As String, Grp As Long, DataRNG As Range

fPATH = "C:\Path\Where\I\Want\My\Files\Saved\"    'remember the final \
Application.ScreenUpdating = False

Set DataRNG = ActiveSheet.UsedRange

    For Grp = 1 To DataRNG.Areas.Count
        DataRNG.Areas(Grp).Copy
        Sheets.Add
        Range("A1").PasteSpecial
        ActiveSheet.Move

        ActiveWorkbook.SaveAs Filename:=fPATH & "-" & Format(Grp, "0000") & ".csv", _
            FileFormat:=xlCSV, CreateBackup:=False
        ActiveWorkbook.Close
    Next Grp

MsgBox "A total of " & Grp & " files were created"
Application.ScreenUpdating = True

End Sub

【讨论】：

谢谢！但无法开始使用它。它不断抛出一些错误。请原谅我的愚蠢，但我从来都不是 VB 和 Excel 人。
当你在错误信息处调试时，哪一行代码出错了？这通常会很快指出需要在您的版本中针对您的环境进行编辑的内容。

【解决方案3】：

在您对我的评论的回复中，您说：“文件名，我从来没有想过它。现在可能是任何东西。”从痛苦的经历中，我可以告诉你，处理成千上万个系统生成名称的文件是一场噩梦。您现在需要解决名称问题。

我也对AddrToCopy = Split(Rng.Address, ",") 感到紧张。 Rng.Address 的形式为：“$C$1:$I$16, $K$1:$Q$16, $S$1:$Y$16, $C18$I$33, $K$18:$Q$33, $S 18 美元：33 美元，……”。如果您搜索互联网，您会发现一些网站告诉您Rng.Address 的最大长度为 253 个字符。我不相信这是正确的。以我的经验，Rng.Address 在完整的子范围内被截断。我的实验是使用 Excel 2003，但我发现在 Internet 上注意到此限制已在更高版本的 Excel 中得到修复。你用你的 Excel 版本检查Rng.Address！我不熟悉 Jerry Beaucaire，尽管他提供了一个有趣的解决方案。 Sid Rout 总是能产生出色的代码。如果有问题，我相信他们能够解决它。

但是，这个“答案”的真正目的是说我会将这个问题分成三个。我知道这有很多优点，没有缺点。

第 1 步。创建一个新工作表 TableSpec，其中包含以下列：

A      Worksheet name. (If tables are spread over more than worksheet) 
B      Range. For example: C1:I16, K1:Q16
C - I  Headings from table. For example, AAPL, Open, High, Low, Close, Volume, AdjClose

步骤 2. 检查工作表TableSpec；例如，是否列出了所有表格？考虑文件名并添加 H 列以包含它。我读到您的一个 cmets 表示您将“AAPL”作为第一个表的文件名，在这种情况下，您可以将 H2 设置为“=C2”。 “AAPL”是独一无二的吗？你可以有一个序列号。在生成任何文件之前，您可以考虑很多选择。

第 3 步。工作表TableSpec 现在提供了生成文件所需的所有信息。您可以删除大部分内容并在几行上测试文件创建代码。

我希望您能看到这种阶梯式方法的优势，尤其是在您的 VBA 较弱的情况下。祝你好运。

【讨论】：