Question

我有带有以下工作表的excel文件。

城市1
City2
City3
City4
City5等，直到47张

文件目标为“ C：\ Users \ Dell \ Desktop \ CityData \”

如何将文件拆分为单独的工作表，然后将其放置在与工作表名称相同的文件夹中。文件夹不存在，我想自动创建文件夹。这些文件夹应创建为上述目标文件夹的子文件夹。

Answer 1

 Sub SplitSheets()
 Const FolName = "C:\Users\Dell\Desktop\CityData\"
 Dim ws as worksheet
 for each ws in worksheets
        ws.copy
        Mkdir folname & ws.name
        activeworkbook.saveas folname & ws.name & "\" & ws.name & ".xlsm",52
        activeworkbook.close
  next ws
   end sub

Answer 2

您可以使用它将工作簿拆分为单独的工作表。

Sub Splitbook()
'Updateby20140612
Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
    xWs.Copy
    Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
    Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

您可以使用以下代码复制和移动文件。

Sub Copy_Folder()
'This example copy all files and subfolders from FromPath to ToPath.
'Note: If ToPath already exist it will overwrite existing files in this folder
'if ToPath not exist it will be made for you.
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String

    FromPath = "C:\your_from_path\"  '<< Change
    ToPath = "C:\your_to_path\"    '<< Change

    'If you want to create a backup of your folder every time you run this macro
    'you can create a unique folder with a Date/Time stamp.
    'ToPath = "C:\your_to_path\" & Format(Now, "yyyy-mm-dd h-mm-ss")

    If Right(FromPath, 1) = "\" Then
        FromPath = Left(FromPath, Len(FromPath) - 1)
    End If

    If Right(ToPath, 1) = "\" Then
        ToPath = Left(ToPath, Len(ToPath) - 1)
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If

    FSO.CopyFolder Source:=FromPath, Destination:=ToPath
    MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath

End Sub

如果要将多个文件扫描到多个不同的文件夹中，则可以使它更具动态性。我认为最好的方法是在一列中列出文件夹，然后循环浏览该项目列表。这样的事情可以解决问题。

Dim r As Range '-- if you don't declare it as a range type you get a variant type as default
Dim c As Range '-- this is used to store the single cell in the For Each loop
Set r = Range("A1:B10") '-- substitute your range as per your example
For Each c In r '-- you could also use r.cells
    MsgBox c.Value '-- pass to your function instead of a call to the Message Box
Next

将文件拆分为多个工作簿并保存在单独的文件夹中

2 个答案: