Need a Macro to Copy template excel sheet multiple times and rename sheets based on list on hidden sheet

MrCheese · Sep 4th 2021

In search of a macro that will do the following

I have a sheet1 "student" = active sheet
sheet3 "Sort Sheet" = hidden sheet (contains a list in column C, Row 1 to 12)

The list will not be more than 12 rows, but could be as few as 2

I would like the user to press a "button" on the sheet that will:

1. Copy the active sheet

2. Rename the current active sheet to the name of a student in "Sort Sheet" column "C":Row "1"

3. Copy the current active sheet after the active sheet

4. Rename the new active sheet to the next name in the "Sort Sheet" Column "C":Row "2"

5. Continue the process until all sheets have been copied and renamed based on the list

Thank you for all your help! Cheers!

**KjBox** · Sep 4th 2021

Attach a sample workbook.

MrCheese · Sep 4th 2021

"Student" sheet will be the active sheet the user will view and interact with.

The following sheets will be hidden from user:

1. Sort Sheet

2. 2021 - Smart Phonics 3 Grades

3. Book Info

4. Class_Book_List

5. Complete_Student_List

Numbers 2, 4, 5, will update from other files on network.

Number 1 - "Sort Sheet" will update from drop down lists chosen by the user on the "Student" sheet.

**KjBox** · Sep 4th 2021

Thanks. Do you need each new sheet to update with the data for that student? In other words automatically enter the student E & K Full Name in cell P24?

MrCheese · Sep 4th 2021

KjBox, That would be amazing for that to update too.

**KjBox** · Sep 4th 2021

Try the attached. I have hidden all but the Student sheet.

As you no doubt discovered, the new Excel SORT and FILTER functions are great, except for when trying to get the results of the functions into VBA. You need to go back to the source Table and get the required data from there.

This is the code now assigned to the button

Code

Option Explicit

Sub CopySheet()
    Dim x, e, oDic As Object, i As Long, sClass As String
    x = [Complete_Student_List]: sClass = Sheet1.[o24]
    Set oDic = CreateObject("scripting.dictionary")
    
    For i = 1 To UBound(x, 1)
        If x(i, 1) = sClass Then
            oDic.Add x(i, 3), x(i, 5)
        End If
    Next
    SortArray oDic.keys, LBound(oDic.keys), UBound(oDic.keys)
    Application.ScreenUpdating = 0
    For Each e In oDic.keys
        Sheet1.Copy , Sheets(Sheet1.Index)
        With ActiveSheet
            .[p24] = oDic(e)
            .Name = e
        End With
    Next
    
End Sub

Sub SortArray(x, i As Long, ii As Long)
  Dim y, z, iii As Long, iv As Long
  iii = i: iv = ii
  y = x((i + ii) \ 2)

  While (iii <= iv)
     While (x(iii) < y And iii < ii)
        iii = iii + 1
     Wend
     While (y < x(iv) And iv > i)
        iv = iv - 1
     Wend
     If (iii <= iv) Then
        z = x(iii): x(iii) = x(iv)
        x(iv) = z: iii = iii + 1
        iv = iv - 1
     End If
  Wend
  If (i < iv) Then SortArray x, i, iv
  If (iii < ii) Then SortArray x, iii, ii
  
End Sub

Display More

MrCheese · Sep 5th 2021

That is outstanding! Thank you so much! Cheers!

**KjBox** · Sep 5th 2021

You're welcome

Need a Macro to Copy template excel sheet multiple times and rename sheets based on list on hidden sheet

Participate now!

Share

Tags