VBA从列表创build单独的工作表并将数据复制到同一列表中的每个工作表

我有一个工作簿2张： 学生和模板 。

在学生我有一个列3列： StudentName ， StudentUser和StudentPassword 。

模板是访问某个数据库的指南，它有3个字段，我必须从学生列表中获取3个信息。

我正在尝试为每个学生创buildVBA单独的工作表，复制该模板，将其命名为“Student_”和StudentName * ，并在每个工作表上添加学生列表中的3个不同信息，

• 学生姓名在B2 ，
• 用户在D15 ，和
• 密码到D17

这是让我头痛的代码，因为我没有设法在新创build的表上获得用户和密码：

 Sub CreateAndNameWorksheetsStudents() Dim c As Range Dim u As Range Dim p As Range Application.ScreenUpdating = False For Each c In Sheets("Students").Range("A2:A3") Sheets("Template").Copy After:=Sheets(Sheets.Count) With c ActiveSheet.Name = "Elev_" & .Value .Parent.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:= _ "'" & "Parinte_" & .Text & "'!A1", TextToDisplay:=.Text End With c.Copy ActiveSheet.Range("B2").PasteSpecial For Each u In Sheets("Students").Range("B2:B3") u.Copy ActiveSheet.Range("D15").PasteSpecial Next u For Each p In Sheets("Students").Range("C2:C3") p.Copy ActiveSheet.Range("D17").PasteSpecial Next p Next c Application.ScreenUpdating = True End Sub 

有人可以告诉我我做错了什么吗？

谢谢

Answer 1

试试这个：

 Sub CreateAndNameWorksheetsStudents() Dim c As Range, rng As Range Dim nSh As Worksheet Application.ScreenUpdating = False With Sheets("Students") Set rng = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row) End With For Each c In rng Sheets("Template").Copy After:=Sheets(Sheets.Count) Set nSh = Sheets(Sheets.Count) With c nSh.Name = "Elev_" & .Value .Parent.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:= _ "'" & nSh.Name & "'!A1", TextToDisplay:=.Text nSh.Range("B2").Value = .Value nSh.Range("D15").Value = .Offset(, 1).Value nSh.Range("D17").Value = .Offset(, 2).Value End With Next c Application.ScreenUpdating = True End Sub