VBA help required in creating multiple workbooks from one workbook.

Multiboard

New Member
Joined
Mar 7, 2024
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Hello all and thank you very much for your contribution to this platform.

I'm very very new to VBA and I was wondering if you could help in creating a macro which produces multiple workbooks as well as renaming them.

I have a folder on my desktop called Test1 which contains 2 excel files, wkb and Master_file.

For the file called wkb, the column A contains a list of numerical codes except the cell A1 which is the header called Filenames.

All I'm trying to do is to create a macro where once actioned, it will create copies of the Master_file and rename these as per the codes in column A which can contain 1 as well as 100.

For instance, say the cell A2= 222, then the new workbook will be a copy of the Master_file and will be renamed 222.xlxs

Lastly, I would like all the new workbooks to be saved in a folder called Test2 located on my desktop at C:\Users\Multiboard\Desktop\Test2

I would like to kindkly ask you if you could help in creating a macro for the above query.

I bought a book about VBA and Macros by Miscrosoft but at the moment I'm finding it not really easy :)

Thank you.
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Since you want to learn, see if you can error check in case files exist in "Test2" with a name you're giving it.
And what you want to do in case there is one with that name.
Check all references in the macro and change as required. They all have an .xlsx extension (Not .xlxs).
Macro is in a third workbook that has been save somewhere else.
Code:
Sub Maybe_So()
Dim wb1 As Workbook, wb2 As String
Dim fldr As String, i As Long
fldr = CreateObject("WScript.Shell").specialfolders("Desktop")
Application.ScreenUpdating = False
Set wb1 = Workbooks.Open(fldr & "\Test1\wkb.xlsx")
wb2 = fldr & "\Test1\Master_file.xlsx"
    For i = 2 To wb1.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
        FileCopy wb2, fldr & "\Test2\ " & wb1.Sheets(1).Cells(i, 1).Value & ".xlsx"
    Next i
wb1.Close False
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Good afternoon jolivanes,

Thank you for your macro. I made few mistakes when changing the references, at the end, I managed to get it working and learnt something new :)

Thank you a million, your macro makes the task very efficient and quick.

I have one more macro to create and I was hoping for your advice on whether this can be done in VBA.

Going back to my first post, the file wkb contains 5 columns holding alphanumerical data.

Header in cell A1 = Filenames (this column was used in your first macro to create files having the same name as per the data in column A)

Header in cell B1 = Reference 1

Header in cell C1 = Reference 2

Header in cell D1 = Reference 3

Header in cell E1= Reference 4

All I need to do is to copy/paste/save data from the wkb file to the files stored in the folder Test2, which were created by using your first macro.

For instance say cell A2 of wkb is XYZ2, Test2 folder would contain a file called XYZ2.xlsx

The new macro needs to copy/paste/save data from row 2 of the wkb to XYZ2.xlsx as per below

wkb – cell B2 goes into C1 of XYZ2.xlsx

wkb – cell C2 goes into I1 of XYZ2.xlsx

wkb – cell D2 goes into B6 of XYZ2.xlsx

wkb – cell E2 goes into C6 of XYZ2.xlsx

then say cell A3 of wkb is XYZ3, the following would apply

wkb – cell B3 goes into C1 of XYZ3.xlsx

wkb – cell C3 goes into I1 of XYZ3.xlsx

wkb – cell D3 goes into B6 of XYZ3.xlsx

wkb – cell E3 goes into C6 of XYZ3.xlsx

This operation would continue as long as there is data in column A of wkb; also the receiving cells are always the same, C1, I1,B6 and C6.

After all the files in the folder Test2 have been filled is, the folder Test2 will be emptied and a new cycle will start.

I once again, thank you very much in advance.
 
Upvote 0
Re: After all the files in the folder Test2 have been filled is, the folder Test2 will be emptied and a new cycle will start. Please explain

Check ALL references and change where required.
Code:
Sub Maybe_So_Version2()
Dim wb1 As Workbook, wb2 As Workbook
Dim fldr As String, i As Long, j As Long
Dim dataArr, destArr
Dim sh1 As Worksheet, sh2 As Worksheet
fldr = CreateObject("WScript.Shell").specialfolders("Desktop")
destArr = Array("C1", "I1", "B6", "C6")
Application.ScreenUpdating = False
Set wb1 = Workbooks.Open(fldr & "\Test1\wkb.xlsx")
Set wb2 = Workbooks.Open(fldr & "\Test1\Master_file.xlsx")
Set sh1 = wb1.Worksheets("Sheet1")    '<---- Change as required
Set sh2 = wb2.Worksheets("Sheet1")    '<---- Change as required
dataArr = sh1.Cells(1).CurrentRegion.Value
    For i = 2 To UBound(dataArr, 1)
        With sh2
            For j = LBound(destArr) To UBound(destArr)
                .Range(destArr(j)).Value = dataArr(i, j + 2)
            Next j
        End With
        wb2.SaveCopyAs fldr & "\Test2\ " & dataArr(i, 1) & ".xlsx"
    Next i
wb1.Close False
wb2.Close False
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Good afternoon Jolivanes,
thank you very much for another great Macro, it works perfectly without any issue.
Regarding your question about emptying Test2 folder and the new cycle. Basically, after the files are created in Test2, these files will be transferred in other folders and by doing so the Test2 folder will be empitied. Then at the end of each month I will receive another wkb file with new references, I run your macro, the Test2 folder will contain the new created files which will be transferred to other folders and so on; I hope it makes sense. Once again, thank you a trillion , I really appreciated that:)
 
Upvote 0
Thanks for the update. Very much appreciated as well as the kind words and the explanation.
Good Luck
 
Upvote 0

Forum statistics

Threads
1,223,886
Messages
6,175,195
Members
452,616
Latest member
intern444

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top