请教各位大神如何按员工部门批量生成新表

Yalishanda30

方法很多种

shiruiqiang

照着刘老师写的

3190496160

拆分问题到我到的主题里去下载拆分工具，下载就能用，几个拆分工具一定有一个适合你的

ZHLK

Sub 宏1()
Dim sht As Worksheet
Application.ScreenUpdating = False
    Set sht = Sheets.Add(After:=Sheets(Sheets.Count))
    Sheets("5月考勤").Columns("P:P").Copy sht.Columns("A:A")
    ActiveSheet.Range("$A$1:$A$" & sht.Range("a65320").End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlNo
    arr = sht.UsedRange
For i = 2 To UBound(arr)
    Set sht = Sheets.Add(After:=Sheets(Sheets.Count))
    sht.Name = arr(i, 1)
    With sht.ListObjects.Add(SourceType:=0, Source:="ODBC;DSN=Excel Files;DBQ=" & ThisWorkbook.FullName, Destination:=Range( _
        "$A$1")).QueryTable
        .CommandText = "SELECT * FROM [5月考勤$] where [部门]='" & arr(i, 1) & "'"
        .ListObject.DisplayName = "表_" & i
        .Refresh BackgroundQuery:=False
    End With
    sht.Cells.EntireColumn.AutoFit
Next i
Application.ScreenUpdating = True

   
End Sub

fzxba

测试.rar (253.01 KB, 下载次数: 29)

2023-6-6 17:01 上传

点击文件名下载附件

洋务德雷

乖狗儿 发表于 2023-6-6 15:17
我愁死了

你的办公软件是wps，还是office？针对你的办公软件，我有不同的方法来做。

gwjkkkkk

fzxba 发表于 2023-6-6 17:01

这个牛X，一网打尽。。。

fzxba

gwjkkkkk 发表于 2023-6-6 18:52
这个牛X，一网打尽。。。

高兄晚上好！

乖狗儿

洋务德雷 发表于 2023-6-6 17:26
你的办公软件是wps，还是office？针对你的办公软件，我有不同的方法来做。

目前是office,好厉害啊，太感谢了！！

乖狗儿

才看到楼上好多大神帮我回复了，太感谢了，太牛了吧。我一个个来认真研究！向您们学习！！