老师：您这个代码是要分4个工作表分表的，如果分3个工作表分表代码改那个地方？

宝贝优博

Sub cf()
Dim arr, brr()
Set d = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    For Each sh In Worksheets
        If sh.Name <> "数据汇总" Then sh.Delete
    Next
Application.DisplayAlerts = True
arr = Range("a1:l" & Cells(Cells.Rows.Count, 1).End(3).Row)
u1 = UBound(arr): u2 = UBound(arr, 2)
    For i = 2 To u1
        d(arr(i, 3)) = ""
    Next
    shs = d.keys
    For Each sh In shs
        ReDim brr(1 To u1, 1 To u2)
        Worksheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = sh
            For i = 2 To u1
                If arr(i, 3) = sh Then
                    n = n + 1
                    For j = 1 To u2
                        brr(n, j) = arr(i, j)
                    Next
                End If
             Next
    Worksheets("数据汇总").Range("a2:l" & n + 1).Copy
    ActiveSheet.Range("a2").PasteSpecial Paste:=xlPasteColumnWidths
    ActiveSheet.Range("a2").PasteSpecial Paste:=xlPasteFormats
    Worksheets("数据汇总").[a1:g1].Copy ActiveSheet.[a1]
    ActiveSheet.[a2].Resize(n, u2) = brr: n = 0: ActiveSheet.[a1].Select
    Next
Worksheets("数据汇总").Activate
Application.ScreenUpdating = True
MsgBox "拆分完成！", , "温馨提示^_^"
End Sub

microyip

字典里有几个表就会分成几个咯，你把字典去掉不要的就自然生成少了

不知道为什么

microyip 发表于 2020-1-12 16:26
字典里有几个表就会分成几个咯，你把字典去掉不要的就自然生成少了

microyip大师，您咋都不休息啊？

宝贝优博

microyip 发表于 2020-1-12 16:26
字典里有几个表就会分成几个咯，你把字典去掉不要的就自然生成少了

老师，如果改变拆分的列，改哪里？现在说按照c列拆分的，想改到h列