VBA help required: Creating multiple workbooks from a template and a list of names, and some other details

[mradomir]

I tried to use code from this thread:

VBA help required: Creating multiple workbooks from a template and a list of names

Hopefully someone smarter than me can provide me with a neat VBA macro that will do the following; The easiest way I can describe the scenario I am trying to create, is to use a company list of personnel (my index) and to generate a time-sheet workbook per person based on a pre-populated...

www.mrexcel.com

But I have problem with adding new details in "template" using nested "For Each". I tried to ask there:

VBA help required: Creating multiple workbooks from a template and a list of names

Hopefully someone smarter than me can provide me with a neat VBA macro that will do the following; The easiest way I can describe the scenario I am trying to create, is to use a company list of personnel (my index) and to generate a time-sheet workbook per person based on a pre-populated...

www.mrexcel.com

but I saw that is recommended to start new thread (because it is from 2013), and I will copy my question from there:

JLGWhiz said:
Try it this way.
Code:
Sub create()
Dim wb As Workbook, sh1 As Worksheet, lr As Long, rng As Range
Set sh1 = Sheets("Index") 'Edit sheet name
Set sh2 = Sheets("Data") 'Edit sheet name
lr = sh1.Cells(Rows.Count, "Q").End(xlUp).Row
Set rng = sh1.Range("Q16:Q" & lr)
For Each c In rng
Sheets("Template").Copy 'Edit sheet name
Set wb = ActiveWorkbook
wb.Sheets(1).Range("D10") = c.Value
sh2.Copy After:=wb.Sheets(1)
wb.SaveAs c.Value & ".xlsx"
wb.Close False
Next
End Sub

I know that is very old thread, but it is a very useful for me, and thank you for that. I have additional question: I have to import additional cell from sheet "data" (for example from column R of the same row) in some other place of sheet "template" (for example in E6 cell). When I try to do this in the same way as you add cells from column Q of sheet "data" to sheet D10 cell in "template", I succeed but I always get cell from the last row, and I need it from the same row. Can you, please, help me?

 

[mmhill]

Here's an approach. I'm not a fan of the End(xlUp) approach as it errors if there's a stray value. This approach starts at Q16 and goes down 1 cell at a tme until it hits a blank cell. When you wrote, "from column R of the same row" I assumed you meant the sae row as the Q column. That is if you are reading Index!Q16 pasted into new sheet (the Template Copy) cell D10, you want Data!R16 pasted into new sheet cell E6. I also renamed the variables to make them easier to follow.

Sub create()
Dim wsIndex As Worksheet, rngIndex As Range, wsData As Worksheet,  rngData As Range, i%
Dim wbNew As Workbook

    Set wsIndex = Sheets("Index") 
    Set rngIndex = wsIndex.Range("Q16") 'starting cell for what to paste in D10
    Set wsData = Sheets("Data")
    Set rngData = wsData.Range("R16") 'starting cell for what to paste in E6
    i = 0
    
    Do While Not Len(rngIndex.Offset(i, 0)) = 0 'starting at Q16, go down 1 row at a time until you hit an empty cell
    
        Sheets("Template").Copy
        Set wbNew = ActiveWorkbook
        wsData.Copy After:=wbNew.Sheets(1)
        
        With wbNew.Sheets(1)
            .Range("D10") = rngIndex.Offset(i, 0) 'starting at Q16, you offset 1 additional row at each loop
            .Range("E6") = rngData.Offset(i, 0) 'starting at R16, you offset 1 additional row at each loop
        End With
        
        wbNew.SaveAs rngIndex.Offset(i, 0) & ".xlsx"
        wbNew.Close False
        
        i = i + 1
    
    Loop
    
    Set wsIndex = Nothing
    Set wsData = Nothing
    Set rngIndex = Nothing
    Set rngData = Nothing
    Set wbNew = Nothing

End Sub

 

[mradomir]

Thank you very much!
Because all my data are in "index" sheet, and "data" sheet have to stay the same for all, I changed code here:
from:
Set rngData = wsData.Range("R16") 'starting cell for what to paste in E6
I changed in
Set rngIndex = wsData.Range("R16") 'starting cell for what to paste in E6
and I get everithing I wanted

Thank you again
It is much faster than using End(xlUp)

 

[mradomir]

Thank you very much!
Because all my data are in "index" sheet, and "data" sheet have to stay the same for all, I changed code here:
from:
Set rngData = wsData.Range("R16") 'starting cell for what to paste in E6
I changed in
Set rngIndex = wsData.Range("R16") 'starting cell for what to paste in E6
and I get everithing I wanted

Thank you again
It is much faster than using End(xlUp)

Not there - here:
from
Set rngData = wsData.Range("R16") 'starting cell for what to paste in E6
I changed in
Set rngData = wsIndex.Range("R16") 'starting cell for what to paste in E6