紧急求助！！！根据汇总表批量生成excel格式的个人简介表

誓死拿下excel

紧急求助，接到领导命令，明天中午之前要完成：汇总表有近500条个人信息，现在需要批量生成每个人的个人简介表，是固定格式的excel表格。恨自己学业不精啊，没有头绪。附件的汇总表我给出了5条信息，需要的结果是这5个人的个人简介表，各位大仙显神通吧！跪谢！

cstnjy

帮顶吧，我也想学习此类知识点

guojing618

坐等大神回复

grf1973

见附件。为慎重计，仅显示打印预览。如需打印在代码中小改一下既可。

1. Sub tt()
   
2.     Dim wb As Workbook
   
3.     On Error Resume Next
   
4.     Set wb = Workbooks.Open(ThisWorkbook.Path & "\汇总.xls")
   
5.     Set wb1 = wb.Sheets("Sheet1")
   
6.     r = wb1.[b65536].End(3).Row
   
7.     arr = wb1.Range("a6:z" & r)
   
8.     wb.Close False
   
9.     ThisWorkbook.Activate
   
10.     For i = 1 To UBound(arr)
    
11.         [c5] = arr(i, 2): [g5] = arr(i, 3): [m5] = arr(i, 4): [o5] = arr(i, 5)
    
12.         [s5] = arr(i, 6): [v5] = arr(i, 7)
    
13.         [c6] = arr(i, 8): [g6] = arr(i, 9): [k6] = arr(i, 10): [u6] = arr(i, 11)
    
14.         [c14] = arr(i, 12): [q14] = arr(i, 13): [s14] = arr(i, 14): [v14] = arr(i, 15)
    
15.         [c16] = arr(i, 16): [g16] = arr(i, 17): [k16] = arr(i, 18): [m16] = arr(i, 19)
    
16.         [q16] = arr(i, 20): [s16] = arr(i, 21): [v16] = arr(i, 22)
    
17.         [c21] = arr(i, 23): [g21] = arr(i, 24): [k21] = arr(i, 25): [u21] = arr(i, 26)
    
18.         ThisWorkbook.Sheets(1).PrintPreview        '预览
    
19.         'ThisWorkbook.Sheets(1).Printout           '如需打印用此句
    
20.     Next
    
21.    End Sub
    

复制代码

zqg420

参考一下{:soso_e100:}