VBA to choose template, fill it in and then save workbook - impossible??????

Hello and welcome to the forum. All the tasks you have noted are possible to code with loops, but that's not the problem that I see. If you are fortunate then one of the members will have some time to code all of this (and test it). If this thread goes cold, then I would advise you to start new threads with small bite sized problem and increment until you finish your project. And of course, there is little change of help with a dummy workbook.

Good luck.

abousetta

Post up your sample source workbook with the templates in it (sanitize the data to generic content, leave the layout alone), then post a sample "results" workbook for one manager and one or two of his him employees. We'll take a look from there.

Click GO ADVANCED and use the paperclip icon to post up a copy of your workbook.

Hi abousetta and JBeaucaire,
Thanks for getting back to me so quick.

I have attached a simpler version of my data sheet, templates and results as a lot of data is being pulled.
However, I have not amended the formatting as requested.

Thank you so much for your help.

That is there for the specific purpose you've found... to serve as a "beginning" for putting a row-based dataset into a standard template. So I would encourage you to try and adapt that very macro... yes, adding more "action" code to do more than the original sample. Build on it.

I have now managed to adapt coding to select the correct template.
I decided to autofilter the 'data sheet' for each manager so that when I finish the project, I can just loop through each autofilter sub and then run the 'fill in template'.

How can I adapt the code below to only take action if the row it's working on is not hidden via the autofilter?

Sub FillOutTemplate()
'Jerry Beaucaire  4/25/2010
'From Sheet1 data fill out template on sheet2 and save
'each sheet as its own file.
Dim LastRw As Long, Rw As Long, Cnt As Long
Dim dSht As Worksheet, rtSht1 As Worksheet, rtSht2 As Worksheet, dtSht1 As Worksheet, dtSht2 As Worksheet, dptSht1 As Worksheet, dptSht2 As Worksheet
Dim MakeBooks As Boolean, SavePath As String
Dim rng As Range, cell As Range
Dim row As Range

Application.ScreenUpdating = False  'speed up macro execution
Application.DisplayAlerts = False   'no alerts, default answers used

Set dSht = Sheets("Data Sheet")           'sheet with data on it starting in row2
Set rtSht1 = Sheets("R Template sheet 1")       'sheet to copy and fill out
Set rtSht2 = Sheets("R Template sheet 2")
Set dtSht1 = Sheets("D Template sheet 1")
Set dtSht2 = Sheets("D Template sheet 2")
Set dptSht1 = Sheets("DP Template sheet 1")
Set dptSht2 = Sheets("DP Template sheet 2")

'Option to create separate workbooks
    MakeBooks = MsgBox("Create separate workbooks?" & vbLf & vbLf & _
        "YES = template will be copied to separate workbooks." & vbLf & _
        "NO = template will be copied to sheets within this same workbook", _
            vbYesNo + vbQuestion) = vbYes

If MakeBooks Then   'select a folder for the new workbooks
    MsgBox "Please select a destination for the new workbooks"
    Do
        With Application.FileDialog(msoFileDialogFolderPicker)
            .AllowMultiSelect = False
            .Show
            If .SelectedItems.Count > 0 Then    'a folder was chosen
                SavePath = .SelectedItems(1) & "\"
                Exit Do
            Else                                'a folder was not chosen
                If MsgBox("Do you wish to abort?", _
                    vbYesNo + vbQuestion) = vbYes Then Exit Sub
            End If
        End With
    Loop
End If


    LastRw = dSht.Range("A" & Rows.Count).End(xlUp).row
        
    For Rw = 2 To LastRw
        If dSht.Range("D" & Rw).Value = ("R") Then
        rtSht1.Copy After:=Worksheets(Worksheets.Count)   'copy the template
        With ActiveSheet                                'fill out the form
            'edit these rows to fill out your form, add more as needed
            .Name = dSht.Range("B" & Rw)
            .Range("B3").Value = dSht.Range("A" & Rw).Value
            .Range("C4").Value = dSht.Range("B" & Rw).Value
            .Range("D5:D7").Value = dSht.Range("C" & Rw, "E" & Rw).Value
            rtSht2.Copy After:=Worksheets(Worksheets.Count)
            With ActiveSheet
            .Name = dSht.Range("B" & Rw) + " Disc"
        End With
        End With

                
       ElseIf dSht.Range("D" & Rw).Value = "DP" Then
            dptSht1.Copy After:=Worksheets(Worksheets.Count)   'copy the template
            With ActiveSheet                                'fill out the form
                'edit these rows to fill out your form, add more as needed
                .Name = dSht.Range("B" & Rw)
                .Range("B3").Value = dSht.Range("A" & Rw).Value
                .Range("C4").Value = dSht.Range("B" & Rw).Value
                .Range("D5:D7").Value = dSht.Range("C" & Rw, "E" & Rw).Value
                dptSht2.Copy After:=Worksheets(Worksheets.Count)
                With ActiveSheet
                .Name = dSht.Range("B" & Rw) + " Disc"
            End With
            End With

        
        Else: dSht.Range("D" & Rw).Value = "D"
            dtSht1.Copy After:=Worksheets(Worksheets.Count)   'copy the template
            With ActiveSheet                                'fill out the form
                'edit these rows to fill out your form, add more as needed
                .Name = dSht.Range("B" & Rw)
                .Range("B3").Value = dSht.Range("A" & Rw).Value
                .Range("C4").Value = dSht.Range("B" & Rw).Value
                .Range("D5:D7").Value = dSht.Range("C" & Rw, "E" & Rw).Value
                 dtSht2.Copy After:=Worksheets(Worksheets.Count)
                With ActiveSheet
                .Name = dSht.Range("B" & Rw) + " Disc"
        End With
        End With

        End If

              
        
        If MakeBooks Then       'if making separate workbooks from filled out form
            ActiveSheet.Move
            ActiveWorkbook.SaveAs SavePath & Range("B3").Value, xlNormal
            ActiveWorkbook.Close False
        End If
        
        Cnt = Cnt + 1

Next Rw

    dSht.Activate
    
    If MakeBooks Then
        MsgBox "Workbooks created: " & Cnt
    Else
        MsgBox "Worksheets created: " & Cnt
    End If
    
Application.ScreenUpdating = True
End Sub

Many thanks.

If you have applied a filter, then you can set a RNG variable for the remaining visible row. Then you can cycle through the "cells" in the RNG and use the cell.row:

Dim LastRw As Long, RNG as Range, cell As Range

    LastRw = dSht.Range("A" & Rows.Count).End(xlUp).row
    Set RNG = dSht.Range("A2:A" & LR).SpecialCells(xlCellTypeVisible)

    For Each cell in RNG
        If dSht.Range("D" & cell.Row).Value = ("R") Then
            rtSht1.Copy After:=Worksheets(Worksheets.Count)     'copy the template

...etc