按店铺名称，分成多个工作簿

英子-TS

yeu118 发表于 2024-7-1 16:44
这样是保存到哪里呢

你要拆分的工作表的路径

gwjkkkkk

Option Explicit
Sub test()
    Dim ar, i&, dic As Object, vKey, Rng As Range, wks As Worksheet, strFileName$, strPath$

    DoApp False
    Set dic = CreateObject("Scripting.Dictionary")
    With [A1].CurrentRegion
        ar = .Value
        Set Rng = .Rows(1)
        For i = 2 To UBound(ar)
            If Not dic.exists(ar(i, 10)) Then
                Set dic(ar(i, 10)) = Rng
            End If
            Set dic(ar(i, 10)) = Union(dic(ar(i, 10)), .Rows(i))
        Next
    End With
   
    strPath = ThisWorkbook.Path & "\"
    For Each vKey In dic.keys
        strFileName = strPath & vKey
        With Workbooks.Add
            dic(vKey).Copy
            .Sheets(1).[A1].PasteSpecial xlPasteColumnWidths
            dic(vKey).Copy .Sheets(1).[A1]
            .SaveAs strFileName
            .Close
        End With
    Next
    Set dic = Nothing: Set Rng = Nothing
    DoApp
    Beep
End Sub
Function DoApp(Optional b As Boolean = True)
    With Application
        .ScreenUpdating = b
        .DisplayAlerts = b
        .Calculation = -b * 30 - 4135
    End With
End Function

飞天篮球猪

供参考...一句就可以完成：

38180203

wps就自己带有这个功能

闻启学

38180203 发表于 2024-7-1 21:03
wps就自己带有这个功能

WPS 要是会员才有的功能 ！！

lizhipei78

https://club.excelhome.net/thread-1681303-1-1.html
原格式，通用拆分，一看就懂得