老板急催，饭碗不稳！
请问如何根据现有的excel总表，自动生成明细表？
比如，现有一张excel表：
序号 姓名 年龄 工资
1 张三 33 4000
2 李四 34 5000
3 王五 35 6000
...
需要将每行的数据依次生成在一张excel的多个sheet中，而且自动将sheet1改为姓名，即每人一个sheet表格
第一个sheet表为
姓名：张三
年龄：33
工资：4000
张三（sheet1）
第二个sheet表为
姓名：李四
年龄：34
工资：5000
李四（sheet2）
...
后面依次类推，如何转化啊？在线等高手援助，谢谢！
------解决方案--------------------------------------------------------
先用一个循环去读取数据，然后新建表，进行表名命名就可以了，具体可用以下方法：先在SHEET1中判断力数据有多少行，然后建立一个循环读取，再新建表，例如：
Option Explicit
Sub test()
Dim i As Long
Dim j As Long
Dim K As String
Worksheets("sheet1").Select
i = Cells(1, 1).CurrentRegion.Rows.Count
For j = 2 To i
K = Worksheets("sheet1").Range("B" & j).Value
Worksheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = K
Worksheets("" & K).Range("A1").Value = "姓名"
Worksheets("" & K).Range("A2").Value = "年龄"
Worksheets("" & K).Range("A3").Value = "工资"
Worksheets("" & K).Range("B1").Value = Worksheets("sheet1").Range("B" & j).Value
Worksheets("" & K).Range("B2").Value = Worksheets("sheet1").Range("C" & j).Value
Worksheets("" & K).Range("B3").Value = Worksheets("sheet1").Range("D" & j).Value
Next
ActiveWorkbook.Save
End Sub
------解决方案--------------------------------------------------------
- VB code
Sub test() Dim i&, k%, arr(1 To 3, 1 To 2), temp Application.ScreenUpdating = False Application.DisplayAlerts = False temp = Sheet1.[a1].CurrentRegion For i = 2 To UBound(temp) Sheets.Add after:=Sheets(Sheets.Count) With ActiveSheet .Name = temp(i, 2) .[a1] = "公司人员报表" .[a1:b1].Merge arr(1, 1) = "姓名" arr(1, 2) = temp(i, 2) arr(2, 1) = "年龄" arr(2, 2) = temp(i, 3) arr(3, 1) = "工资" arr(3, 2) = temp(i, 4) .[a2].Resize(3, 2) = arr Erase arr End With Next Application.DisplayAlerts = True Application.ScreenUpdating = TrueEnd Sub