CODEWITHSUNDEEP
excelvba
cristian.angyal
cristian.angyal

Reputation: 21

VBA to create separate sheets from list and copy data to each sheet from the same list

I have a workbook with 2 sheets: Students and Template.

In Students I have a list with 3 columns: StudentName, StudentUser and StudentPassword.

The Template Sheet is a guide to acces a certain database and it has 3 fields where I have to get the 3 info from the Student list.

I'm trying to create with VBA separate sheets for each Student, copying the Template, naming it *"Student_" & StudentName*, and adding on each sheet the 3 different info from Students list on certain locations on the new created sheet

This is the code which is giving me headache as I don't manage to get the user and password on the new created sheet:

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

Can someone tell me what am I doing wrong, please?

Thank you

Upvotes: 2

Views: 2396

Answers (1)

Dmitry Pavliv
Dmitry Pavliv

Reputation: 35863

Try this one:

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

Upvotes: 2

Related Questions