I am delighted to use the forum for the first time.
I encounter an issue with my excel vba function.
Not being a coder, I went online looking for some vba code that would allow me to "print" a template version ("Template" spreadsheet) of the rows info filled on a first sheet ("Main" spreadsheet).
So I found something. that works.
Here is the code :
response = MsgBox("Are you sure you want to save ?", vbYesNo)
If response = vbNo Then MsgBox ("Operation cancelled.") Exit Sub End If
rspn = InputBox("Please enter password") If rspn <> "secret" Then MsgBox "Operation cancelled." Exit Sub End If
Dim LastRw As Long, Rw As Long, Cnt As Long Dim dSht As Worksheet, tSht As Worksheet Dim MakeBooks As Boolean, SavePath As String
Application.ScreenUpdating = False 'speed up macro execution Application.DisplayAlerts = False 'no alerts, default answers used
Set dSht = Sheets("Main") 'sheet with data on it starting in row4 Set tSht = Sheets("Template") 'sheet to copy and fill out
'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 to save the Personal Information Templates" 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
'Determine last row of data then loop through the rows one at a time LastRw = dSht.Range("A" & Rows.Count).End(xlUp).Row
For Rw = 4 To LastRw tSht.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("F" & Rw) .Range("E1").Value = dSht.Range("A" & Rw).Value .Range("B2").Value = dSht.Range("F" & Rw).Value .Range("C2").Value = dSht.Range("G" & Rw).Value .Range("E2").Value = dSht.Range("E" & Rw).Value
If MakeBooks Then 'if making separate workbooks from filled out form ActiveSheet.Move ActiveWorkbook.SaveAs SavePath & Range("E2").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
There are two things I would like to fix,
1) How to delete the option of choosing between saving all the templates in the same workbook ?? I would like that the only option is to save the templates in separate workbooks.
("YES = template will be copied to separate workbooks." & vbLf & _ "NO = template will be copied to sheets within this same workbook", _)
2) How to instead of generating multiple workbooks, it would generate multiple PDF ? Is there a lot to do to adapt the code ?