急求助，改需求从源表中取数据放到目标表中相应位置后，按每个员工的姓名生成....

kykykyky

从源表中取数据放到目标中相应位置，按每个员工的姓名生成一个表文件，其中的姓名、部门、工号要从《起重操作名册》中对应记录抓取。从源表《起重操作名册》中取出姓名，部门，工号，放到表《吊车地操操作证样板》中的相应位置，按每个人的姓名和工号生成一个《吊车地操操作证样板》表文件，一共106个人，生成106个《吊车地操操作证样板》表文件,且表文件名为"姓名.xls"

182197315

楼主试试，看看能否得到你想要的结果。

182197315

Sub 自动生成证件()
Application.ScreenUpdating = False
Dim i%, arr, mypath$, wb As Workbook
mypath = ThisWorkbook.Path & "\"
arr = Range("A2:E" & Range("E65536").End(xlUp).Row)
For i = 1 To UBound(arr)
    FileCopy mypath & "吊车地操操作证样板.xls", mypath & arr(i, 2) & ".xls"
    Set wb = Workbooks.Open(mypath & arr(i, 2) & ".xls")
    With wb.Sheets(1)
        .Range("B4") = arr(i, 2)
        .Range("D4") = arr(i, 4)
        .Range("F4") = arr(i, 1)
    End With
    wb.Close True
Next
Application.ScreenUpdating = True
End Sub

kykykyky

老师点击运行后，提示“拒绝的权限”，是什么意思啊，没有运行成功

kykykyky

老师您好，提示错误是“运行错误70，拒绝的权限”

蓝桥玄霜

请见附件。
一键生成106个工作簿文件，当心了。

kykykyky

感谢蓝桥老师，不过还有个封皮页没有生成，就是每个员工的证件对应一个sheet2,那是个封皮，您的代码，那个sheet2没有了

一条鱼ONE-FISH

一口气生成106个文件，你的电脑要靠得住呀。
我将花名册放到你的样板文件中了，省得在几个工作簿之间切换。
如下请参考。

1. Sub MingCe()
   
2. Dim i As Integer, ArrNameList, List As Worksheet, Card As Worksheet, Cover As Worksheet
   
3. Set List = Worksheets("List")
   
4. Set Card = Worksheets("Sheet1")
   
5. Set Cover = Worksheets("Sheet2")
   
6. 
   
7. ArrNameList = List.Range("A1:E" & List.Cells(Rows.Count, 1).End(xlUp).Row)
   
8. Application.ScreenUpdating = False
   
9. 
   
10. For i = 2 To UBound(ArrNameList)
    
11. 'For i = 2 To 5
    
12.     Card.Range("B4") = ArrNameList(i, 2)
    
13.     Card.Range("D4") = ArrNameList(i, 4)
    
14.     Card.Range("F4") = ArrNameList(i, 1)
    
15.    
    
16.     Card.Range("B13") = ArrNameList(i, 2)
    
17.     Card.Range("D13") = ArrNameList(i, 4)
    
18.     Card.Range("F13") = ArrNameList(i, 1)
    
19.    
    
20.     Cover.Range("B3") = ArrNameList(i, 2)
    
21.     Cover.Range("D3") = ArrNameList(i, 4)
    
22.     Cover.Range("F3") = ArrNameList(i, 1)
    
23.    
    
24.     Sheets(Array("Sheet1", "Sheet2")).Select
    
25.     Sheets("Sheet1").Activate
    
26.     Sheets(Array("Sheet1", "Sheet2")).Copy
    
27.     ActiveWorkbook.SaveAs ThisWorkbook.Path & "" & ArrNameList(i, 2)
    
28.     ActiveWorkbook.Close
    
29. Next i
    
30. 
    
31. Application.ScreenUpdating = True
    
32. End Sub
    

复制代码

kykykyky

感谢一条鱼ONE-FISH老师，多谢您