Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Duplicate and name workbooks on list of names

Posted on 2013-01-18
15
Medium Priority
?
394 Views
Last Modified: 2013-01-20
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
0
Comment
Question by:Alex Campbell
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 5
  • 3
15 Comments
 
LVL 43

Accepted Solution

by:
Saqib Husain, Syed earned 2000 total points
ID: 38793905
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
 
LVL 7

Expert Comment

by:Jignesh Thar
ID: 38793933
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
 
LVL 7

Expert Comment

by:Jignesh Thar
ID: 38793935
Attached is file with macro
0
NFR key for Veeam Backup for Microsoft Office 365

Veeam is happy to provide a free NFR license (for 1 year, up to 10 users). This license allows for the non‑production use of Veeam Backup for Microsoft Office 365 in your home lab without any feature limitations.

 
LVL 1

Author Comment

by:Alex Campbell
ID: 38794181
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
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 38794241
Have you tried the first one? It asks for the file name.
0
 
LVL 7

Expert Comment

by:Jignesh Thar
ID: 38794268
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
 
LVL 1

Author Comment

by:Alex Campbell
ID: 38794506
Perfect, just what I was looking for.
0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 38794766
Hi, can you please tell me why the first one did not work?
0
 
LVL 1

Author Comment

by:Alex Campbell
ID: 38794793
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
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 38795349
That is exactly what the first one does. That one is

Sub generatefiles()
0
 
LVL 1

Author Comment

by:Alex Campbell
ID: 38795353
The first macro stopped and asked for the file name in a data entry box

The next one gave a listing of files
0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 38795381
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
 
LVL 1

Author Comment

by:Alex Campbell
ID: 38795439
my apologies i missed that
0
 
LVL 1

Author Closing Comment

by:Alex Campbell
ID: 38798910
my apologies for missing your correct solution the first time
I also for help to resolve my error
0

Featured Post

Ransomware-A Revenue Bonanza for Service Providers

Ransomware – malware that gets on your customers’ computers, encrypts their data, and extorts a hefty ransom for the decryption keys – is a surging new threat.  The purpose of this eBook is to educate the reader about ransomware attacks.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

715 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question