Excel自动化拆分工作表

Sub 拆分工作表()

Dim str As String
Dim dic
Dim rng, cell As Range

    Set dic = CreateObject("Scripting.Dictionary")
    str = ActiveWorkbook.Path
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next

Line1:

    Set rng = Application.InputBox(prompt:="请选择要拆分的列：" & Chr(13), Type:=8)
    If IsEmpty(rng) Or rng Is Nothing Then
        Exit Sub
    End If
    
    Do While rng.Columns.Count > 1
        MsgBox "提示：选择区域超过一列，请重新选择！"
        Set rng = Nothing
        GoTo Line1
    Loop
    
    For Each cell In Range(rng(2), rng(rng.Count).End(xlUp))
        dic(cell.Value) = 1
    Next
    
    For Each Item In dic
    
        ActiveSheet.AutoFilterMode = False
        ActiveSheet.UsedRange.AutoFilter Field:=rng.Column, Criteria1:=Item
        ActiveSheet.UsedRange.Copy
        Workbooks.Add
        
        With Selection
            .PasteSpecial Paste:=xlPasteColumnWidths
            .PasteSpecial Paste:=xlPasteValues
            .PasteSpecial Paste:=xlPasteAllUsingSourceTheme
        End With
        
        ActiveWindow.SplitRow = 1
        ActiveWindow.FreezePanes = True
        Application.CutCopyMode = False
    
        
        '自适应列宽
        'ActiveSheet.UsedRange.EntireColumn.AutoFit

        If Dir(str & "拆分", vbDirectory) = "" Then
            MkDir str & "拆分"
        End If
        
        ActiveWorkbook.SaveAs Filename:=str & "拆分电商名单_" & Item
        
        'ActiveWorkbook.SaveAs Filename:=str & "拆分错误点位详情_" & item
        'ActiveWorkbook.SaveAs Filename:=str & "拆分成本录入_" & item, FileFormat:=xlCSV
        'ActiveWorkbook.SaveAs Filename:=str & "拆分展示广告促销（2017.2-7.24）- " & Item & ".xlsx"
        
        ActiveWorkbook.Save
        ActiveWorkbook.Close
        
    Next
    
    ActiveSheet.AutoFilterMode = False
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub

把上面代码直接copy到excel的宏中运行，在窗口中选数据源对应列（根据哪一列拆分选哪一列），点击运行即可

最后

以上就是单纯大雁为你收集整理的Excel自动化拆分工作表的全部内容，希望文章能够帮你解决Excel自动化拆分工作表所遇到的程序开发问题。

如果觉得靠谱客网站的内容还不错，欢迎将靠谱客网站推荐给程序员好友。