Create a workbook from a list and then name it according to the contents of 2 cells

[Flavien]

Hi all
I am contacting you because I cannot find an answer to my questions and unfortunately I am unable to adapt the similar cases already addressed.

I now that Xmas was 2 weeks ago, but if someone could help me, I'll be grateful!

I have 2 workbooks : "Gestionnaire de creation" (masterworkbook) & "Classeur1 GCU - V00" (The one that I want to duplicate).
The first contains a list of data:
(A) Plan No / (B) Index / (C) Description / (D) Clients / ... (cf pictures uploaded)

The second contains a table with 2 columns.
(A) Fixe / (B) Variable
There are the 6 elements of a row in the column (B).

I would like to copy each row (one by one), from the master workbook, and then paste it into the second file in column (B) of the table sheet("CARTOUCHE") and to finish save the second file as the value from the cells A2 and B2 and add "GCU - V00"
I need to repeat this procedure as many times as there are rows. (The number of rows may vary from list to list).

Both workbooks are not registered in the same folder and duplicated workbooks should to be registered in a third folder.

By advance thank you.

 

[Peter_SSs]

Welcome to the MrExcel board!

See if you can adapt and use something like this.
I have this macro in the master workbook
My workbook that is to be duplicated is called "To Duplicate.xlsx". Adjust the code for your workbook name.
I have assumed that both workbooks are open.
The folder where the new files are to saved also needs to be edited in the code.

Sub Create_Workbooks()
  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
  End With
End Sub

 

[Flavien]

Hi Peter_SSs,

Thank you very much for your help, the macro program works!

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

Does it mean that new workbooks should be saved in this folder?

On my side the workbooks are saved in the same folder as my template workbook (= GCU - MODELE), Maybe this is normal?

Another question, would you know how to automatically close the last workbook generated by the macro knowing that its name may vary?

Thank you again for your help!!

Have a nice day

 

[Peter_SSs]

would you know how to automatically close the last workbook generated by the macro knowing that its name may vary?

This should account for that change

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

On my side the workbooks are saved in the same folder as my template workbook (= GCU - MODELE),

I am confused by that. It would indicate that we are dealing with perhaps two folders:
a) The one that the master workbook is stored in and
b) The one the template workbook and the newly created workbooks are stored in.

However, previously you stated:

.. duplicated workbooks should to be registered in a third folder.

Can you clarify what the situation actually is?

 

[Flavien]

Hello Peter_SSs,

Thank you for your reply, I'll will try your suggestion

Don’t worry, my English is not perfect.

Please, Do you think that it is possible to save all the “new workbooks” in a third folder?

 

[Peter_SSs]

Do you think that it is possible to save all the “new workbooks” in a third folder?

My code already does that provided you list the third folder in the 'Const' line in the code.

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

 

[Flavien]

Hello Peter!
Hope you are feeling good today.

I met a problem with the macro. I don't know why, the new files are not saved following to the "DestFolder", but in the same folder than the last file modified.

For example:
I worked on a filed named P7323 - GCU - v00.xlsx (P:\01-Qualité\K - Qualité Usinage\02 - En cours de création\P7323\1 - GCU\P7323 - GCU - v00.xlsx).

***
Here is the macro

Sub Creer_classeur_GCU()


  Dim wbToDupe As Workbook
  Dim wsExtr As Worksheet
  Dim rVar As Range
  Dim NewName As String
  Dim i As Long
 
  Application.ScreenUpdating = False
 
  Workbooks.Open Filename:="P:\01-Qualité\K - Qualité Usinage\05 - CREATION PCP PREMIER NIVEAU\12-DC-11 - Gamme contrôle usinage - v00.xlsx"

 
  Const DestFolder As String = "P:\01-Qualité\K - Qualité Usinage\05 - CREATION PCP PREMIER NIVEAU" '<- Edit as required
 
  Set wbToDupe = Workbooks("12-DC-11 - Gamme contrôle usinage - v00.xlsx") '<- Edit as required
  Set wsExtr = ThisWorkbook.Sheets("EXTRACTION")
  Set rVar = wbToDupe.Sheets("TABLE - Cartouche").ListObjects(1).DataBodyRange.Cells(1, 2) 'renvoie à une colonne à l'exception de l'entête
  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 = "P" & rVar.Cells(1, 1).Value & " - " & rVar.Cells(2, 1).Value & " - " & " GCU - V00.xlsx"
      wbToDupe.SaveAs Filename:=NewName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
      Set wbToDupe = Workbooks(NewName)
      Set rVar = wbToDupe.Sheets("TABLE - Cartouche").ListObjects(1).DataBodyRange.Cells(1, 2)
    Next i
  End With
  wbToDupe.Close
  Application.ScreenUpdating = True
 
End Sub

Thank you for your help.

Have a nice day.

 

[Peter_SSs]

When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time.

You have made a couple of changes to the code that need checking

Mine

Const DestFolder As String = "F:\Testing\abcd\"

Yours - missing final "\"

Const DestFolder As String = "P:\01-Qualité\K - Qualité Usinage\05 - CREATION PCP PREMIER NIVEAU"

Mine

wbToDupe.SaveAs Filename:=DestFolder & NewName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

Yours

wbToDupe.SaveAs Filename:=NewName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

Try addressing those two issues and see how you go. Clearly I cannot properly test your code as I do not have the files or folder structure.

 

[Flavien]

Thank you very much Peter, it works

 

[Peter_SSs]

Good news. Thanks for the confirmation.
You are very welcome.