VBA 总表拆分不同工作表后，添加序号，一键打印总表与分表

田蘖

VBA 总表拆分不同工作表后，添加序号，一键打印总表与分表

这是我在论坛中找到的一段代码，但我还需要在分表A列中自动添加序号，还可以一键打印总表与分表怎么办？请各位老师指点。

田蘖

这个是我在论坛中找到的代码



Option Explicit
Sub 筛选()
Dim d As Object, lr&, ar, r&, k, sh As Worksheet, tt As Range, shtnm$
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each sh In Sheets
    If sh.Name <> "物料清单" Then sh.Delete
Next
Application.DisplayAlerts = True
Set d = CreateObject("scripting.dictionary")
With Sheets("物料清单")
    lr = .[b65536].End(2).Row
    ar = [a1].Resize(lr, 10)
    For r = 2 To UBound(ar)
        If Len(ar(r, 9)) Then
            shtnm = ar(r, 9)
            If Not d.exists(shtnm) Then
                Set d(shtnm) = .Cells(r, 1).Resize(1, 10)
            Else
                Set d(shtnm) = Union(d(shtnm), .Cells(r, 1).Resize(1, 10))
            End If
        End If
    Next
End With
If d.Count Then
    Set tt = Sheets("物料清单").[a20].Resize(1, 10)
    For Each k In d.keys
        Sheets.Add After:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = k
            tt.Copy .[a1]
            d(k).Copy .[a2]
            .Columns("a:v").AutoFit
            .DrawingObjects.Delete
        End With
    Next
End If
Set d = Nothing
Set tt = Nothing
Sheets("物料清单").Activate
Application.ScreenUpdating = True
MsgBox "分类完成"
End Sub

田蘖

这是附件，请老师指点。

田蘖

朱荣兴 发表于 2019-6-8 15:08
没有附件，没人帮得了你的，是在上传不了，加我QQ

刚刚上传成功，浏览器不太好用....

田蘖

朱荣兴 发表于 2019-6-8 15:20
删除你的代码中强制定义变量的代码
Sub 筛选()
Application.ScreenUpdating = False

老师你好，谢谢您的帮助，确实是自动添加了序号，不过分表的数量不对，目前是5个工作表，用您的代码“拆分”后是3个，缺少2个（分表的数量以后可能会增加，数量不固定）

田蘖

朱荣兴 发表于 2019-6-8 15:20
删除你的代码中强制定义变量的代码
Sub 筛选()
Application.ScreenUpdating = False

老师，你好，我将您的  lr = .Cells(Rows.Count, 1).End(xlUp).Row  改回  lr = .[b65536].End(2).Row   就好用了，感谢您的帮助。

田蘖

朱荣兴 发表于 2019-6-8 17:49
其实，把1改成2即可

谢谢老师，还有个问题需要您帮忙，我想将分表中提取标题行的行数向上在加几行能实现吗？另外能批量自动根据单元格内容调整单元格行高与列宽与根据分表中的内容范围自动设置打印区域，然后批量打印除总表外的所有分表吗？