将一个工作表根据条件拆分成多个工作表

更新时间2018-08-06 05:09:52

将一个工作表根据条件拆分成多个工作表，按客户名称分成多个工作表，写成VBA宏比较方便。

Sub 拆分()

'将工作表“321”，按客户名称分成多个工作表

    r = Application.CountA(Range("A:A"))

    Range("A:A").Select

    ActiveWorkbook.Worksheets("321").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("321").Sort.SortFields.Add Key:=Range("B2:B" & r), _

        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    ActiveWorkbook.Worksheets("321").Sort.SortFields.Add Key:=Range("A2:A" & r), _

        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets("321").Sort

        .SetRange Range("A1:C" & r)

        .Header = xlYes

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

    For i = 2 To r

    If Cells(i - 1, 2) <> Cells(i, 2) Then

        ShName = Cells(i, 2)

        n = 1

        Sheets.Add After:=Sheets(Sheets.Count)

        Sheets("321").Select

        Sheets(Sheets.Count).Name = ShName

        Sheets(ShName).Range("A:A").NumberFormatLocal = "yyyy-m-d"

        Sheets(ShName).Cells(1, 1) = Cells(1, 1)

        Sheets(ShName).Cells(1, 2) = Cells(1, 3)

    End If

    n = n + 1

    Sheets(ShName).Cells(n, 1) = Cells(i, 1)

    Sheets(ShName).Cells(n, 2) = Cells(i, 3)

    Sheets(ShName).Range("A:B").EntireColumn.AutoFit

    Next i

    Range("A1").Select

End Sub