Dupe and save a wbk within a new folder, according cells value

[Flavien]

Hello!

The below vba code works well. With it I can open a template workbook and save it with a new name according cells value.
I'd like to go further and copy/paste a template folder before to save as the new workbook.
Moreover I'd like to make the program more flexible with address of destfolder and workbooks in cells.

Could someone help me please?




Sub Create_Workbooks_v2()
Dim wbToDupe As Workbook
Dim wsExtr As Worksheet
Dim rVar As Range
Dim NewName As String
Dim i As Long

Const DestFolder As String = "F:\Testing\abcd\" '<- Edit as required

Set wbToDupe = Workbooks("To Duplicate.xlsx") '<- Edit as required
Set wsExtr = ThisWorkbook.Sheets("EXTRACTION")
Set rVar = wbToDupe.Sheets("CARTOUCHE").ListObjects(1).DataBodyRange.Cells(1, 2)
With wsExtr
For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
.Range("A" & i).Resize(, 6).Copy
rVar.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
NewName = rVar.Cells(1, 0).Value & " " & rVar.Cells(1, 1).Value & " GCU - V00.xlsx"
wbToDupe.SaveAs Filename:=DestFolder & NewName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Set wbToDupe = Workbooks(NewName)
Set rVar = wbToDupe.Sheets("CARTOUCHE").ListObjects(1).DataBodyRange.Cells(1, 2)
Next i
wbToDupe.Close
End With
End Sub

 

[OaklandJim]

Your need is not totally clear. Do you want to create a folder for the new workbooks based on a cell value?

Is it possible to see the workbook, maybe with fake but realistic data? You can put a link to the file -- saved to Dropbox, 1 drive, etc. -- using the link icon above the message box.

Another option is to provide the data using Mr Excel's excellent addin called XL2BB. See HERE.

If you want the folder to be specified in a cell helper will need to know which cell contains it.