修改excel 并按名单分别生成新的excel文件，放到其他盘的文件夹中

jyfscn

各位老师好：

我这边想写一个marco,点击一个按钮选择一个加班表，然后从marco里面按人员名单修改加班表，有几个人员名单就修改几份加班表，最后统一放置到另外一个文件夹中，方便大家自己填写加班，但我做的marco有点乱,想请哪位老师帮我做个好点的。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.1.9
   
2.     Dim ws, wb, arr
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     p = ThisWorkbook.Path & "\2024\01"
   
6.     With Sheets("Team member information")
   
7.         r = .Cells(Rows.Count, 2).End(3).Row
   
8.         arr = .Range("a1:f" & r)
   
9.     End With
   
10.     With Application.FileDialog(msoFileDialogFilePicker)
    
11.         .InitialFileName = ThisWorkbook.Path & ""
    
12.         .Title = "请选择对应Excel文件"
    
13.         .AllowMultiSelect = False
    
14.         .Filters.Clear
    
15.         .Filters.Add "Excel文件", "*.xls*"
    
16.         If .Show Then f = .SelectedItems(1) Else Exit Sub
    
17.     End With
    
18.     Set ws = Workbooks.Open(f, 0)
    
19.     Set sh = ws.Sheets(1)
    
20.     For i = 2 To UBound(arr)
    
21.         fn = arr(i, 2)
    
22.         sh.Copy
    
23.         Set wb = ActiveWorkbook
    
24.         With wb.Sheets(1)
    
25.             .[d9] = fn
    
26.             .[d12] = arr(i, 4)
    
27.             .[k9] = arr(i, 3)
    
28.             .[i12] = arr(i, 5)
    
29.             .[k12] = arr(i, 6)
    
30.             .[j56] = arr(i, 4)
    
31.         End With
    
32.         wb.SaveAs p & "122024_" & fn
    
33.         wb.Close 1
    
34.     Next
    
35.     ws.Close False
    
36.     Application.ScreenUpdating = True
    
37.     MsgBox "OK！"
    
38. End Sub
    

复制代码

ykcbf1100

附件供参考。。。

jyfscn

ykcbf1100 发表于 2024-1-9 14:40
附件供参考。。。

谢谢老师！老师太厉害了！完美符合要求！就是我现在水平不够，还没积攒到花，以后争取！

ykcbf1100

jyfscn 发表于 2024-1-9 16:05
谢谢老师！老师太厉害了！完美符合要求！就是我现在水平不够，还没积攒到花，以后争取！

送花也有要求吗？

熊文来

ykcbf1100 发表于 2024-1-9 14:40
附件供参考。。。

确实很好啊。

ykcbf1100

熊文来 发表于 2024-1-9 21:10
确实很好啊。

你很识货啊，这个例子其实很经典，平时经常会遇到。

这就是总表按模板拆分为多表的例子。

熊文来

ykcbf1100 发表于 2024-1-9 21:11
你很识货啊，这个例子其实很经典，平时经常会遇到。

一看到你的作品，立马留住脚步。

ykcbf1100

熊文来 发表于 2024-1-9 21:12
一看到你的作品，立马留住脚步。

你应该还记得以前我给你写过代码吧

熊文来

ykcbf1100 发表于 2024-1-9 21:16
你应该还记得以前我给你写过代码吧

绝对记得啊，帮我写过。提高了效率。