求助，怎么用vba拆分表格

城南花谢

做账单的时候需要拆分表格，并保留表头和表尾、方便打印；刚开始学还不怎么会，哪位大神可以帮下忙
说明：
1、表1数据 选取自表2部份列；  

要求：
1、表1根据B列（供应商）拆分表格
2、拆分后的表格需有表头、表尾（A1：L2、A41：L43）
3、拆分后表格名称及A1单元格需再原文本基础加上供应商名字，例：东北供应商A2019年3月账单明细汇总
4、拆分后的表尾合计金额需重新求和
5、拆分后A列序号按正确顺序调整
6、拆分后的表格格式与原表一致，避免重新调整格式及打印调整
7、拆分后的表格也需要和原表一样有表1表2，且表2 C列的供应商拆分与表1的供应商保持一致

zpy2

格式要求高，代码比较麻烦的

城南花谢

^.^是有点，手头的代码只能基础的拆，没什么用，也不方便打印；数据一多就比较耗时，容易出错

xiangbaoan

城南花谢 发表于 2019-5-5 16:25
^.^是有点，手头的代码只能基础的拆，没什么用，也不方便打印；数据一多就比较耗时，容易出错

Option Explicit
Sub test()
Dim ar, br(1 To 2), d As Object, i&, j&, k&, f$, s$, t$
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
With Worksheets(1)
    t = .[a1]
    ar = .Range("b3:b" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    For i = 1 To UBound(ar)
        s = ar(i, 1)
        If Not d.exists(s) Then d(s) = ""
    Next
    br(1) = .Name
End With
With Worksheets(2)
    ar = .Range("c2:c" & .Cells(.Rows.Count, 3).End(xlUp).Row)
    For i = 1 To UBound(ar)
        s = ar(i, 1)
        If Not d.exists(s) Then d(s) = ""
    Next
    br(2) = .Name
End With
Application.DisplayAlerts = False
For i = 0 To d.Count - 1
    s = d.keys()(i)
    f = ThisWorkbook.Path & "\" & s & t & ".xlsx"
    Worksheets(br).Copy
    With ActiveWorkbook
        With .Worksheets(1)
            For j = .Cells(.Rows.Count, 1).End(xlUp).Row To 3 Step -1
                If .Range("b" & j) <> s Then .Rows(j).Delete
            Next
            k = 0
            For j = 3 To .Cells(.Rows.Count, 1).End(xlUp).Row
                k = k + 1
                .Range("a" & j) = k
            Next
            .DrawingObjects.Delete
        End With
        With .Worksheets(2)
            For j = .Cells(.Rows.Count, 3).End(xlUp).Row To 2 Step -1
                If .Range("c" & j) <> s Then .Rows(j).Delete
            Next
        End With
        .SaveAs f, 51
        .Close
    End With
Next
Set d = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "OK!", 64
End Sub

城南花谢

xiangbaoan 发表于 2019-5-26 08:24
Option Explicit
Sub test()
Dim ar, br(1 To 2), d As Object, i&, j&, k&, f$, s$, t$

很好用，谢谢大神 ，谢谢……，本来以为不会有了^^。代码暂时看不懂，还要琢磨一下