Duplicate and name workbooks on list of names

I am collecting information on people and what products they use.
In this case, I will be using SoftwareSurvey.xls.
***But, I want to be able to select the file that will be duplicated***

The list of people is People.xlsm
The macro will create:
Tom-SoftwareSurvey.xls
Dick-SoftwareSurvey.xls
Harry-SoftwareSurvey.xls

In each of the created xls files, Sheet1 should be renamed for the person and cell B1 should get their name as well.

I want to run the macro in People.xlsm and be asked for what file to be duplicated with their names.
SurveyForm.xlsm
People.xlsm
LVL 1
Alex CampbellAsked:
Who is Participating?
 
Saqib Husain, SyedConnect With a Mentor EngineerCommented:
Try this macro

Sub generatefiles()
    Dim fn As String, wb As Workbook, cel As Range
    fn = Application.GetOpenFilename("*.xls*,*.xls*")
    For Each cel In Range("A1:A" & Range("A1").End(xlDown).Row)
        Set wb = Workbooks.Open(fn)
        wb.ActiveSheet.Name = cel.Value
        wb.ActiveSheet.Range("B1") = cel
        wb.SaveAs cel & "-" & wb.Name
        wb.Close
    Next cel
End Sub
0
 
Jignesh TharSenior ManagerCommented:
Put below code in People.xlsm. Keep both files in same directory.
Sub CopyFilesWithName()
    strSurveyName = InputBox("Enter survey name", "Survey Name")
    For Each oCells In Range("A:A")
        If oCells.Value = "" Then
            End
        End If
        
        Workbooks.Open Filename:="SurveyForm.xlsm"
        ActiveCell.FormulaR1C1 = oCells.Value
        Sheets("Sheet1").Select
        Sheets("Sheet1").Name = oCells.Value
        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & oCells.Value & "-" & strSurveyName & ".xlsm", FileFormat _
            :=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        ActiveWindow.Close
    Next
End Sub

Open in new window

0
 
Jignesh TharSenior ManagerCommented:
Attached is file with macro
0
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
Alex CampbellAuthor Commented:
Thanks, works well.  I will give you the points because it is so close to what I want, but I would appreciate it if you add a select the filename to be opened for the survey rather than having to hardcode it.
0
 
Saqib Husain, SyedEngineerCommented:
Have you tried the first one? It asks for the file name.
0
 
Jignesh TharSenior ManagerCommented:
Try below code and attached file

Sub CopyFilesWithName()
    strSurveyName = Application.GetOpenFilename
    For Each oCells In Range("A:A")
        If oCells.Value = "" Then
            End
        End If
        
        Workbooks.Open Filename:=strSurveyName
        ActiveCell.FormulaR1C1 = oCells.Value
        Sheets(1).Select
        Sheets(1).Name = oCells.Value
        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & oCells.Value & "-" & ActiveWorkbook.Name & ".xlsm", FileFormat _
            :=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        ActiveWindow.Close
    Next
End Sub

Open in new window

People.xlsm
0
 
Alex CampbellAuthor Commented:
Perfect, just what I was looking for.
0
 
Saqib Husain, SyedEngineerCommented:
Hi, can you please tell me why the first one did not work?
0
 
Alex CampbellAuthor Commented:
It worked, but I had to know the name of the file.
The change showed the files in the directory and I could move to another directory.
0
 
Saqib Husain, SyedEngineerCommented:
That is exactly what the first one does. That one is

Sub generatefiles()
0
 
Alex CampbellAuthor Commented:
The first macro stopped and asked for the file name in a data entry box

The next one gave a listing of files
0
 
Saqib Husain, SyedEngineerCommented:
No it did not. It  was the second one which "stopped and asked for the file name in a data entry box" and it was the the third one which you accepted. You did not try the first one which does ask for file name.
0
 
Alex CampbellAuthor Commented:
my apologies i missed that
0
 
Alex CampbellAuthor Commented:
my apologies for missing your correct solution the first time
I also for help to resolve my error
0
All Courses

From novice to tech pro — start learning today.