写一个将Excel的多个sheet拆分成独立Excel的VBA代码

好的，以下是将Excel的多个sheet拆分成独立Excel的VBA代码：

Sub SplitExcel()

Dim wb As Workbook
Dim ws As Worksheet
Dim newWB As Workbook
Dim wsName As String
Dim savePath As String

Application.ScreenUpdating = False

Set wb = ActiveWorkbook
savePath = wb.Path & Application.PathSeparator

For Each ws In wb.Sheets
wsName = ws.Name
Sheets(wsName).Copy
Set newWB = ActiveWorkbook
newWB.SaveAs Filename:=savePath & wsName & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
newWB.Close
Next ws

Application.ScreenUpdating = True
MsgBox "Split Completed!"

End Sub

请注意：如果希望将多个sheet分别保存到同一个文件夹中，请在savePath变量中指定文件夹路径。同时，此代码仅适用于Excel 2007以上版本。

相关问题

excel多个sheet拆分 宏

Excel多个sheet拆分宏是一种自动化的方式，可用于将一个包含多个sheet的Excel文件拆分成独立的单个sheet文件。它可以提高数据处理的效率和准确性。

首先，我们需要编写一段VBA宏代码来实现拆分功能。首先，我们要定义文件路径和名称，以及要拆分的sheet的数量。然后，我们可以使用For循环来逐个拆分每个sheet。

在每个循环中，我们可以使用Copy方法将当前的sheet复制到一个新的工作簿中。然后，我们可以使用SaveAs方法将新的工作簿保存为一个独立的文件。最后，我们可以使用Close方法关闭保存的工作簿。

完成宏代码后，我们可以在Excel中打开要拆分的文件，然后按下Alt + F8键打开宏对话框。在对话框中选择我们编写的拆分宏，并点击运行。Excel会自动执行宏代码，将每个sheet拆分成独立的文件。

拆分完成后，我们可以在指定的保存路径中找到拆分后的文件。每个文件都包含一个单独的sheet，可以独立进行操作和处理。

使用Excel多个sheet拆分宏可以帮助我们快速处理大量数据，并减少手动操作所需的时间和努力。这些宏代码的编写可以根据具体的需求进行修改和扩展，以适应不同的数据处理场景。

Excel拆分成多个工作簿vba代码

以下是一个示例的VBA代码，用于将Excel工作簿拆分成多个工作簿：

Sub SplitWorkbook()
    Dim OriginalWorkbook As Workbook
    Dim NewWorkbook As Workbook
    Dim OriginalWorksheet As Worksheet
    Dim NewWorksheet As Worksheet
    Dim Cell As Range
    Dim RowCounter As Long
    Dim LastRow As Long
    Dim SplitColumn As Range
    Dim UniqueValues As Collection
    Dim Value As Variant
    
    ' 设置原始工作簿和工作表
    Set OriginalWorkbook = ThisWorkbook
    Set OriginalWorksheet = OriginalWorkbook.Worksheets("Sheet1") ' 替换为您要拆分的工作表名称
    
    ' 设置拆分列范围
    Set SplitColumn = OriginalWorksheet.Range("A:A") ' 替换为您要拆分的列
    
    ' 获取唯一值集合
    Set UniqueValues = New Collection
    On Error Resume Next
    For Each Cell In SplitColumn
        UniqueValues.Add Cell.Value, CStr(Cell.Value)
    Next Cell
    On Error GoTo 0
    
    ' 遍历唯一值并创建新工作簿
    For Each Value In UniqueValues
        ' 创建新工作簿并复制原始工作表的结构和数据
        Set NewWorkbook = Workbooks.Add
        Set NewWorksheet = NewWorkbook.Worksheets(1)
        OriginalWorksheet.Copy Before:=NewWorksheet
        
        ' 删除除唯一值之外的行
        With NewWorksheet
            LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            For RowCounter = LastRow To 2 Step -1 ' 从最后一行开始往上遍历
                If .Cells(RowCounter, 1).Value <> Value Then
                    .Rows(RowCounter).Delete
                End If
            Next RowCounter
        End With
        
        ' 保存新工作簿
        NewWorkbook.SaveAs "路径\" & Value & ".xlsx" ' 替换为您要保存的路径和文件名
        
        ' 关闭新工作簿
        NewWorkbook.Close SaveChanges:=False
    Next Value
End Sub

请注意，您需要根据实际情况进行以下修改：

1. 将`"Sheet1"`替换为您要拆分的工作表名称。
2. 将`"A:A"`替换为您要拆分的列范围。
3. 将`"路径\" & Value & ".xlsx"`替换为您要保存的路径和文件名。

运行此代码后，它将根据指定的列中的唯一值，将原始工作簿拆分为多个新的工作簿，并将每个唯一值命名为文件名。每个新工作簿将只包含与对应唯一值匹配的行。