XL 2013 Copie de 2 onglets en 6 exemplaires et les renommer

[jmten92]

Bonjour,

Je suis inscrit depuis quelques années sur ce forum qui est une vrai mine d'or pour des néophytes comme moi En règle générale, j'arrive à m'en tirer seul mais pas cette fois, c'est trop compliqué pour moi;(
je vous explique mon problème :

j'ai actuellement un classeur avec 6 onglets (3 masqués qui ne nous servent à rien ici)
j'ai déjà une macro (macro 1) qui extrait chaque onglet du fichier vers un répertoire (cette macro fonctionne mais pas exactement comme je veux, j'y reviendrai après)

je veux ajouter une macro (macro2) qui copie mes onglets RETARD TCD et BDD (en valeur uniquement) en 6 exemplaires chacun (dans le même classeur) et ou je puisse spécifier leur nom (manuellement les noms étant spécifiques et non destinés à bouger) dans le code pour les renommer de la façon suivante :
RETARD TCD111, RETARD TCD222... jusqu'à 6
BDD111,BDD222....jusqu'à 6
sachant que l'ordre dans le classeur ne doit pas être les 6 BDD et ensuite les 6 RETARDS mais l'ordre doit être tel que :
RETARD TCD111,BDD111, RETARD TCD222; BDD222.... et ensuite les onglets d'origine

Ca c'était mon premier problème . Ensuite, c'est là ou je reviens à ma première macro (macro1)
il faudrait faire évoluer celle ci :
sachant que je préférerai définir les noms de feuille/classeurs manuellement ds la mesure du possible dans le code
pour qu'elle prenne RETARD TCD111 et BDD111 et qu'elle les extrait vers un classeur du répertoire indiqué dans macro1 (qui contiendra donc ces deux onglets). ce classeur serait nommé XXX111(en rapport avec le 111 qui est commun à retard tcd et bdd)
etc etc pour les autres groupes (les 5 autres donc ) - je détaille pour exemple le deuxième .
pour qu'elle prenne RETARD TCD222 et BDD222 et qu'elle les extrait vers un classeur (qui contiendra donc ces deux onglets). ce classeur serait nommé XXX222(en rapport avec le 111 qui est commun à retard tcd et bdd)

J'espère avoir été suffisamment clair et si un spécialiste pouvait avoir la gentillesse de m'aider, un immense merci par avance ...
Bonne soirée

 

[belkacem_64]

Salut
Ce code enregistre une copie dans le même chemin de fichier
Ceci peut être changé
----------------------------------------

Sub iCopy_Sheets()

Dim iPath As String,i As Byte
iPath = ThisWorkbook.Path & "\"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For i = 1 To 6
Sheets("BDD").Copy
With ActiveWorkbook
' .SaveAs "C:\Users\Jean-Michel\Desktop\test macro\" & & Sheets("BDD").Name & 111 * i
.SaveAs Filename:=iPath & Sheets("BDD").Name & 111 * i
.Close
End With
Sheets("Retard TCD").Copy
With ActiveWorkbook
'.SaveAs "C:\Users\Jean-Michel\Desktop\test macro\" & & Sheets("Retard TCD").Name & 111 * i
.SaveAs Filename:=iPath & Sheets("Retard TCD").Name & 111 * i
.Close
End With

Next
Application.CutCopyMode = False: Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub

 

[jmten92]

Bonjour,
tout d'abord merci pour ta réponse,
j'ai réussi à me débrouillé pour la première partie de ma question cad les copier renommer dans le classeur dc pb réglé de ce coté

pour la deuxième partie (celle à laquelle tu as répondu), j'ai testé ton code qui fonctionne bien sauf que j'obtiens deux classeurs distincts et que je souhaite regrouper mes deux feuilles dans un même classeur dont je pourrai définir le nom dans le code idéalement ....

je te remet donc le code que j'ai adapté pour mon fichier :

Sub iCopy_Sheets()

Dim iPath As String, N As String
iPath = ThisWorkbook.Path & "\"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For i = 1 To 3
Sheets("BDD RUSSIE").Copy
With ActiveWorkbook
' .SaveAs "C:\Users\Jean-Michel\Desktop\test macro\" & & Sheets("BDD").Name & 111 * i
.SaveAs Filename:=iPath & Sheets("BDD RUSSIE").Name & RUSSIE
.Close
End With
Sheets("TCD RETARD RUSSIE").Copy
With ActiveWorkbook
'.SaveAs "C:\Users\Jean-Michel\Desktop\test macro\" & & Sheets("Retard TCD").Name & 111 * i
.SaveAs Filename:=iPath & Sheets("TCD RETARD RUSSIE").Name & RUSSIE
.Close
End With

Next
Application.CutCopyMode = False: Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub

en clair ce que je veux c'est que TCD RETARD RUSSIE et BDD RUSSIE soient copiés vers un nouveau classeur du répertoire (la méthode IPATH est top) qui s'appellerait donc RUSSIE et qui contiendrait donc en feuille 1 le TCD RETARD RUSSIE et en feuille 2 la BDD RUSSIE



merci si tu connais la manip à effectuer...
Bonne journée

 

[belkacem_64]

Salut
Est-ce que cela vous convient

Sub iCopy_Sheets()

Dim wb As Workbook, i As Byte, ii As Byte, c, sh, shh, iPath As String
Set wb = Workbooks.Add
iPath = ThisWorkbook.Path & "\"
With wb
For i = 1 To 6
Set sh = .Worksheets.Add: sh.Name = "BDD" & i * 111: sh.Move After:=Sheets(.Sheets.Count)
Next
For ii = 1 To 6
Set shh = .Worksheets.Add: shh.Name = "Retard TCD" & ii * 111: shh.Move After:=Sheets(.Sheets.Count)
Next
Application.DisplayAlerts = False: Application.ScreenUpdating = False
.SaveAs Filename:=iPath & "RUSSIE"
For Each c In .Sheets
ThisWorkbook.Sheets("BDD").Cells.Copy
If Left(c.Name, 3) = "BDD" Then c.Paste
ThisWorkbook.Sheets("Retard TCD").Cells.Copy
If Left(c.Name, 6) = "Retard" Then c.Paste
If Left(c.Name, 3) = "BDD" Or Left(c.Name, 6) = "Retard" Then GoTo 100
c.Delete
100
Next c
.Save: .Close: End With
Application.DisplayAlerts = True: Application.ScreenUpdating = True

End Sub

 

[jmten92]

Salut, pas tout à fait . Pour plus de clarté dans mes explications, voici le fichier final.
il y'a déjà 2 macros dedans (pour les TCD et BDD, n'en tenez pas compte). Celle qui nous intéresses est ICOPYSHEET.

Quand je la lance, je n'obtiens pas exactement ce que je veux à savoir : Sélectionner la feuille TCD RETARD RUSSIE et BDD RUSSIE et les copier vers un classeur du répertoire actif qui s'appelera RUSSIE. idem pour BDD SGEF et TCD RETARD SGEF qui doivent se copier vers un classeur SGEF....
dans le classeur généré, le TCD doit être en feuille 1 et la BDD en feuille2....

je ne sais pas si je suis suffisamment clair

Un grand merci pour votre aide