將Excel工作表中的數據複製到不同的文件中

Question

我有一個包含大量數據的Excel工作表。數據組織如下， 一組7列和n行;如表格中所示，並且1000個這樣的表格水平放置並且空列分開。屏幕截圖低於..

...

我只是想有保存到不同的文件中的每個「表」的數據。手動它將需要永遠！那麼，有沒有一個宏或者我會自動執行這個任務。 我不熟悉編寫宏或任何VBA的東西。

感謝，

Answer 1

託尼有一個正確的觀點時，他說

如果開始C1表上排21結束，是否在C23鄰桌的開始？如果從K1開始的表在第15行結束，那麼下一個表是從K17還是K23開始？

因此，這裏是將在任何條件下即數據的工作水平或垂直設置代碼。

數據快照

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 

注意：上面的代碼將用於細胞起作用，只有文本值。對於只有數字值你必須使用

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

細胞和字母數字值（如上你的問題），使用此

Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants) 

HTH

希德

Answer 2

只要在任何數據集周圍都有一個空白行和一個空白列，就會發現u使用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 

Answer 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： $ Y $ 33，...「。如果您搜索互聯網，您會發現網站告訴您Rng.Address的最大長度爲253個字符。我不相信這是正確的。根據我的經驗，Rng.Address在一個完整的子範圍內被截斷。我的實驗是在Excel 2003中進行的，但是我發現在互聯網上注意到這個限制已經在更高版本的Excel中修復了。你用你的Excel版本檢查Rng.Address！雖然他提供了一個有趣的解決方案，但我並不熟悉傑瑞博凱爾。 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列來包含它。我讀了你的一個評論意味着你將「AAPL」作爲第一個表的文件名，在這種情況下你可以將H2設置爲「= C2」。 「AAPL」是獨一無二的嗎？你可以有一個序列號。在生成任何文件之前，您可以考慮很多選擇。

第3步。工作表TableSpec現在提供生成文件所需的所有信息。您可以刪除大部分內容並在幾行上測試文件創建代碼。

我希望你能看到這種步驟方法的優點，特別是如果你的VBA很弱的話。祝你好運。