Bonjour à tous et à toutes,
Le code ci-après fonctionne bien et me permet:
- d'ouvrir un classeur "modèle" dont l'adresse est inscrite en dur dans le programme,
- d'y copier des données inscrites au préalable dans le classeur appelant,
- d'enregistrer le classeur appelé mis à jour sous un nouveau nom selon des données inscrites dans des cellules du classeur appelant. Idem le chemin de destination est inscrit en dur dans le programme.
Je souhaiterais :
- que la macro créer pour chaque nouveau classeur un dossier portant le même nom pour y enregistrer ledit nouveau classeur. Je rêve un peu éveillé mais le must serait de copier un dossier modèle et son contenu.
J'espère vraiment que quelqu'un parmi vous aura une solution à mon problème car je suis épuisé.
Dans tous les cas merci !
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
Le code ci-après fonctionne bien et me permet:
- d'ouvrir un classeur "modèle" dont l'adresse est inscrite en dur dans le programme,
- d'y copier des données inscrites au préalable dans le classeur appelant,
- d'enregistrer le classeur appelé mis à jour sous un nouveau nom selon des données inscrites dans des cellules du classeur appelant. Idem le chemin de destination est inscrit en dur dans le programme.
Je souhaiterais :
- que la macro créer pour chaque nouveau classeur un dossier portant le même nom pour y enregistrer ledit nouveau classeur. Je rêve un peu éveillé mais le must serait de copier un dossier modèle et son contenu.
J'espère vraiment que quelqu'un parmi vous aura une solution à mon problème car je suis épuisé.
Dans tous les cas merci !
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
Dernière édition:
