打开Excel文件，点击工作表页签（原始Sheet），右键——查看代码——粘贴入下列内容
Sub ttt()
Dim i As Integer
i = Sheet1.Range("a65536").End(xlUp).Row
Sheets.Add , Sheets(1), i - 1
For n = 2 To i
Sheets(n).Name = Sheet1.Range("d" & n)
Sheet1.Rows(1).EntireRow.Copy Sheets(n).Rows(1)
Sheet1.Rows(n).EntireRow.Copy Sheets(n).Rows(2)
Next
End Sub
关闭VB窗口，运行宏ttt看看是否是你要的。
内容全部来源于网络收集，如有侵权，请联系网站删除：QQ：24596024