Duplicate Sheets and Fill with data based on another sheet

dudemansir

New Member
Joined
Dec 8, 2016
Messages
21
I'm trying to do a few things here. Data will be provided on one of the sheets. In addition the template attached is another sheet. After all the data is present, I need excel to duplicate the template sheet based on the amount of rows there are. Then I need the row data to populate the corresponding cells in the new sheets.
I've been trying a few different macros for this but the incremental increasing of the sheet numbers and the referencing of specific cells is tripping me up. Any help appreciated!

I was looking at some sheet creation macros that duplicated based on cell data, but I can't work out the numbering and cell linking.

0hBQG.png

Y3oUX.png
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Im thinking the INDIRECT formula could help with the incrementing, but not sure of the best way to implement it in the workflow
 
Upvote 0
I'm trying to do a few things here. Data will be provided on one of the sheets. In addition the template attached is another sheet. After all the data is present, I need excel to duplicate the template sheet based on the amount of rows there are. Then I need the row data to populate the corresponding cells in the new sheets.
I've been trying a few different macros for this but the incremental increasing of the sheet numbers and the referencing of specific cells is tripping me up. Any help appreciated!

I was looking at some sheet creation macros that duplicated based on cell data, but I can't work out the numbering and cell linking.

0hBQG.png

Y3oUX.png

this will work but you need to change the sheet names in the code and the field headers for the columns your data comes from

Code:
Sub dudemansir()
Dim wb As Workbook
Dim wsTEMP As Worksheet, wsORG As Worksheet, wsNEW As Worksheet
Dim rng As Range, rngHEAD As Range, cell As Range
Dim lngrow As Long, lngcol As Long
Dim intLAST As Integer, intFIRST As Integer, int1 As Integer, _
    int2 As Integer, int3 As Integer, int4 As Integer, int5 As Integer, _
    int7 As Integer, intROWst As Integer, int6 As Integer

    Set wb = ThisWorkbook
    Set wsTEMP = Sheets("dudemansir2") 'change this to template name
    Set wsORG = Sheets("dudemansir1")  'change this to data sheet name
    
    With wsORG
        lngrow = wsORG.Range("A" & wsORG.Rows.Count).End(xlUp).Row
        lngcol = wsORG.Cells(1, wsORG.Columns.Count).End(xlToLeft).Column
        Set rngHEAD = wsORG.Range(wsORG.Cells(1, 1), wsORG.Cells(1, lngcol))
        
        intLAST = rngHEAD.Find("Last name").Column  'change this to your header for last
        intFIRST = rngHEAD.Find("First Name").Column 'change this to your header for first
        int1 = rngHEAD.Find("Value1").Column     'change this to your header for Value 1
        int2 = rngHEAD.Find("Value2").Column     'change this to your header for Value 2
        int3 = rngHEAD.Find("Value3").Column     'change this to your header for Value 3
        int4 = rngHEAD.Find("Value4").Column     'change this to your header for Value 4
        int5 = rngHEAD.Find("Text1").Column     'change this to your header for text 1
        int6 = rngHEAD.Find("Text2").Column     'change this to your header for text 1
        int7 = rngHEAD.Find("Text3").Column     'change this to your header for text 1
        
        For intROWst = 2 To lngrow
            wsTEMP.Copy after:=Worksheets(Worksheets.Count)
            Set wsNEW = ActiveSheet
            wsNEW.Name = wsORG.Cells(intROWst, intLAST).Value & ", " _
                & wsORG.Cells(intROWst, intFIRST)
            wsNEW.Cells(2, 2).Value = wsORG.Cells(intROWst, intLAST).Value & ", " _
                & wsORG.Cells(intROWst, intFIRST)                          'Your Name
            wsNEW.Cells(2, 5).Value = wsORG.Cells(intROWst, int1).Value    'Project
            wsNEW.Cells(3, 2).Value = wsORG.Cells(intROWst, int2).Value    'Grade
            wsNEW.Cells(3, 5).Value = wsORG.Cells(intROWst, int3).Value    'Date
            wsNEW.Cells(4, 2).Value = wsORG.Cells(intROWst, int4).Value    'Period
            wsNEW.Cells(14, 1).Value = wsORG.Cells(intROWst, int5).Value    'row 14 text
            wsNEW.Cells(15, 1).Value = wsORG.Cells(intROWst, int6).Value    'row 15 text
            wsNEW.Cells(16, 1).Value = wsORG.Cells(intROWst, int7).Value    'row 16 text
        Next
    End With
End Sub
 
Upvote 0
this will work but you need to change the sheet names in the code and the field headers for the columns your data comes from

Code:
Sub dudemansir()
Dim wb As Workbook
Dim wsTEMP As Worksheet, wsORG As Worksheet, wsNEW As Worksheet
Dim rng As Range, rngHEAD As Range, cell As Range
Dim lngrow As Long, lngcol As Long
Dim intLAST As Integer, intFIRST As Integer, int1 As Integer, _
    int2 As Integer, int3 As Integer, int4 As Integer, int5 As Integer, _
    int7 As Integer, intROWst As Integer, int6 As Integer

    Set wb = ThisWorkbook
    Set wsTEMP = Sheets("dudemansir2") 'change this to template name
    Set wsORG = Sheets("dudemansir1")  'change this to data sheet name
    
    With wsORG
        lngrow = wsORG.Range("A" & wsORG.Rows.Count).End(xlUp).Row
        lngcol = wsORG.Cells(1, wsORG.Columns.Count).End(xlToLeft).Column
        Set rngHEAD = wsORG.Range(wsORG.Cells(1, 1), wsORG.Cells(1, lngcol))
        
        intLAST = rngHEAD.Find("Last name").Column  'change this to your header for last
        intFIRST = rngHEAD.Find("First Name").Column 'change this to your header for first
        int1 = rngHEAD.Find("Value1").Column     'change this to your header for Value 1
        int2 = rngHEAD.Find("Value2").Column     'change this to your header for Value 2
        int3 = rngHEAD.Find("Value3").Column     'change this to your header for Value 3
        int4 = rngHEAD.Find("Value4").Column     'change this to your header for Value 4
        int5 = rngHEAD.Find("Text1").Column     'change this to your header for text 1
        int6 = rngHEAD.Find("Text2").Column     'change this to your header for text 1
        int7 = rngHEAD.Find("Text3").Column     'change this to your header for text 1
        
        For intROWst = 2 To lngrow
            wsTEMP.Copy after:=Worksheets(Worksheets.Count)
            Set wsNEW = ActiveSheet
            wsNEW.Name = wsORG.Cells(intROWst, intLAST).Value & ", " _
                & wsORG.Cells(intROWst, intFIRST)
            wsNEW.Cells(2, 2).Value = wsORG.Cells(intROWst, intLAST).Value & ", " _
                & wsORG.Cells(intROWst, intFIRST)                          'Your Name
            wsNEW.Cells(2, 5).Value = wsORG.Cells(intROWst, int1).Value    'Project
            wsNEW.Cells(3, 2).Value = wsORG.Cells(intROWst, int2).Value    'Grade
            wsNEW.Cells(3, 5).Value = wsORG.Cells(intROWst, int3).Value    'Date
            wsNEW.Cells(4, 2).Value = wsORG.Cells(intROWst, int4).Value    'Period
            wsNEW.Cells(14, 1).Value = wsORG.Cells(intROWst, int5).Value    'row 14 text
            wsNEW.Cells(15, 1).Value = wsORG.Cells(intROWst, int6).Value    'row 15 text
            wsNEW.Cells(16, 1).Value = wsORG.Cells(intROWst, int7).Value    'row 16 text
        Next
    End With
End Sub

THanks so much RCBricker. Totally on the right track! I made some modifications (messily) to the Int names and locations as more of what I needed became obvious. This is all processing a google forms submission so I had to drop a Sum in the Total field.

I was wondering though, do you think it makes more sense to just have a set number of sheets (34 in a class) and have them populated instead of generated based on the submission list?
 
Upvote 0
How can I have the Sheet names run from Student1 and upward instead of using the student name as the sheet name?
 
Upvote 0
I was wondering though, do you think it makes more sense to just have a set number of sheets (34 in a class) and have them populated instead of generated based on the submission list?

No this way it is more dynamic. No sense in empty sheets.

dudemansir said:
How can I have the Sheet names run from Student1 and upward instead of using the student name as the sheet name?

you can add a string + a counter and then reference them in a new string

so something like

Code:
strSTU="Student"
intSTU=1
        For intROWst = 2 To lngrow
strSTUDENT=strSTU & intSTU
            wsTEMP.Copy after:=Worksheets(Worksheets.Count)
            Set wsNEW = ActiveSheet
            wsNEW.Name = strSTUDENT
            wsNEW.Cells(2, 2).Value = wsORG.Cells(intROWst, intLAST).Value & ", " _
                & wsORG.Cells(intROWst, intFIRST)                          'Your Name
            wsNEW.Cells(2, 5).Value = wsORG.Cells(intROWst, int1).Value    'Project
            wsNEW.Cells(3, 2).Value = wsORG.Cells(intROWst, int2).Value    'Grade
            wsNEW.Cells(3, 5).Value = wsORG.Cells(intROWst, int3).Value    'Date
            wsNEW.Cells(4, 2).Value = wsORG.Cells(intROWst, int4).Value    'Period
            wsNEW.Cells(14, 1).Value = wsORG.Cells(intROWst, int5).Value    'row 14 text
            wsNEW.Cells(15, 1).Value = wsORG.Cells(intROWst, int6).Value    'row 15 text
            wsNEW.Cells(16, 1).Value = wsORG.Cells(intROWst, int7).Value    'row 16 text
intSTU=intSTU+1
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,590
Messages
6,120,423
Members
448,961
Latest member
nzskater

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top