XL 2013 choix des onglets à copier

pho3nix · 21 Janvier 2020

bonjour,
j'ai une macro qui me permet d'ouvrir un fichier et de copier/coller des feuilles entières mais sans pouvoir choisir les feuilles.

je souhaiterais y intégrer une m-box (ou input-box) entre l'ouverture de fichier2 et la copie des feuilles.
il faudrait la possibilités de taper "S--,S--,S--,S--" (si je veux un mois complet) ou "S--,S--" (si je veux que 2 semaines) ou tout autre choix.
les feuilles ainsi célectionnées seront collées dans mon classeur (fichier1).

ci-joint la macro :

Sub ChoixFichier()

'Affiche la boîte de dialogue "Ouvrir"
ChDir ThisWorkbook.Path

FichierSelect = Application.GetOpenFilename("Tous les fichiers (*.xlsx),*.xlsx", Title:=" ", MultiSelect:=False)

'On sort si aucun fichier n'a été sélectionné ou si l'utilisateur
'a cliqué sur le bouton "Annuler", ou sur la croix de fermeture.
If FichierSelect = False Then Exit Sub

'Affiche ICI la MsgBox .
'MsgBox FichierSelect ' choix des semaines

selectonglet

End Sub

Sub selectonglet()
Dim Fichier1 As String
Dim Fichier2 As String

Fichier1 = ActiveWorkbook.Name 'pilote
Workbooks.Open FichierSelect, 0, ReadOnly:=False
Fichier2 = ActiveWorkbook.Name ' fichier de données saisies

Workbooks(Fichier2).Sheets(1).Copy after:=Workbooks(Fichier1).Sheets(2) ' copie du 1er onglet du fichier selectionné dans le fichier RECAP en 3eme position
Workbooks(Fichier2).Sheets(2).Copy after:=Workbooks(Fichier1).Sheets(3) ' copie du 1er onglet du fichier selectionné dans le fichier RECAP en 4eme position
Workbooks(Fichier2).Sheets(3).Copy after:=Workbooks(Fichier1).Sheets(4) ' copie du 1er onglet du fichier selectionné dans le fichier RECAP en 5eme position
Workbooks(Fichier2).Sheets(4).Copy after:=Workbooks(Fichier1).Sheets(5) ' copie du 1er onglet du fichier selectionné dans le fichier RECAP en 6eme position
Workbooks(Fichier2).Sheets(5).Copy after:=Workbooks(Fichier1).Sheets(6) ' copie du 1er onglet du fichier selectionné dans le fichier RECAP en 7eme position
Workbooks(Fichier2).Close

Fichier1 = ActiveWorkbook.Name 'pilote
Sheets(2).Select
Range("A6").Select

End Sub

xUpsilon · 21 Janvier 2020

Je suis pas sûr d'avoir bien compris mais je pense que le souci c'est que si tu rentres moins de 5 semaines alors les dernières valeurs du tableau sont vides. Sauf que du coup tu n'as pas de feuille dont le nom est "". Donc ça donne une erreur.

Du coup il faut que avant chaque copie tu testes si TOngs(_) <> "".

Bonne continuation

pho3nix · 21 Janvier 2020

j'ai modifié les fichier2 pour qu'il contiennent chaqu'un 5 semaines
le programme fonctionne mème si j'ai le message d'erreur quand j'en sélectionne moins.
je dois arrêter pour aujourd’hui
merci beaucoup de ton aide
a plus

xUpsilon · 21 Janvier 2020

Il suffisait de tester si TOngs(_) était vide avant d'exécuter la ligne de copie tu sais.

A la place de

VB:

Workbooks(Fichier2).Sheets(TOngs(1)).Copy after:=Workbooks(Fichier1).Sheets(TOngs(2))
Workbooks(Fichier2).Sheets(TOngs(2)).Copy after:=Workbooks(Fichier1).Sheets(TOngs(3))
Workbooks(Fichier2).Sheets(TOngs(3)).Copy after:=Workbooks(Fichier1).Sheets(TOngs(4))
Workbooks(Fichier2).Sheets(TOngs(4)).Copy after:=Workbooks(Fichier1).Sheets(TOngs(5))

Ecrire :

Code:

Dim n as integer
For n = 1 to 5
If TOngs(i) <> "" then
    Workbooks(Fichier2).Sheets(TOngs(i)).Copy After:=Workbooks(Fichier1).Sheets(TOngs(i+1))
End if
Next n

Bonne continuation

XL 2013 choix des onglets à copier

pho3nix

XLDnaute Nouveau

xUpsilon

XLDnaute Accro

pho3nix

XLDnaute Nouveau

xUpsilon

XLDnaute Accro

Discussions similaires