将数据从Excel工作表复制到不同的文件
我有一个Excel表，它有一些巨大的数据。 数据组织如下，一组7列和n行; 如表中所示，1000个这样的表格水平放置，空列分开。 屏幕截图如下
…
我只想将每个“表”的数据保存到不同的文件中。 手动它将需要永远！ 那么，有没有一个macros或我会自动执行此任务。 我不熟悉编写macros或任何VBA的东西。
谢谢，
托尼说，他有一个有效的观点
如果从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
希德
只要在任何数据集周围都有一个空行和一个空白列，就会使用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
在回应我的评论时，你说：“文件名，我从来没有想过，现在可能是任何东西。 从痛苦的经历，我可以告诉你，处理数以千计的文件与系统生成的名称是一场噩梦。 您现在需要解决名称问题。
我也对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：$ Y $ 33，…“。 如果你search互联网，你会发现网站告诉你， Rng.Address的最大长度为253个字符。 我不相信这是正确的。 根据我的经验， Rng.Address在一个完整的子范围内被截断。 我的实验是使用Excel 2003，但是我发现在互联网上注意到这个限制已经在更高版本的Excel中被修复了。 你用你的Excel版本检查Rng.Address ！ 虽然他提供了一个有趣的解决scheme，但我并不熟悉杰里·博凯尔（Jerry Beaucaire）。 西德鲁特总是产生优秀的代码。 如果有问题，我相信他们将能够解决这个问题。
但是，这个“答案”的真正目的就是说我会把这个问题分成三个。 这有很多好处，没有我知道的缺点。
步骤1.使用以下列创build一个新的工作表， 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列来包含它。 我读了你的一个评论意味着你将“AAPL”作为第一个表的文件名，在这种情况下你可以设置H2为“= C2”。 “AAPL”是独一无二的吗？ 你可以有一个序列号。 在生成任何文件之前，您可以考虑很多select。
第3步。工作表TableSpec现在提供生成文件所需的所有信息。 您可以删除大部分内容，并在几行上testing文件创build代码。
我希望你能看到这个步骤的好处，特别是如果你的VBA很弱。 祝你好运。