VBA : Copier des plages avec une boucle sur plusieurs feuilles figurant dans ListBox

piga25

XLDnaute Barbatruc
Bonjour le forum,

Je coince toujours sur le VBA, Je me ressouds à vous demander conseil car un clavier vient d'en faire les frais

Avec l'aide du forum, j'ai bien ma liste de feuille qui se met dans la listBox.
Si j'ai bien compris la manip sur l'exemple que j'ai pris, on doit avoir un array pour prendre en compte la liste des feuilles que l'on sélectionne dans cette listBox. C'est après que cela se complique, comment dire qu'il faut faire la copie de certaines plages et cela dans chaque feuille.
La méthode que je souhaite employer est :
0- Affichage des feuilles du fichier source
1- Selectionner les feuilles à copier
2- Mettre à blanc la feuille formulaire du fichier destination (macro: Nouvelle_rencontre)
3- Copier les données de certaines plage dans la première feuille sélectionnée dans cette listBox
5- Archiver la copie dans le fichier destination (macro: Archiver)
6- Remettre à blanc la feuille Formulaire du fichier destination (macro: Nouvelle_rencontre)
7- Boucler sur la seconde feuille, puis la suivante...
8- Fermer le fichier source
9- Sauvegarder le fichier destination

VB:
Private Sub CommandButton1_Click()
Dim wb1 As Workbook, wb2 As Workbook, Ws As Worksheet
Dim MyArray() As String
Dim i As Integer, X As Byte
Set wb1 = ThisWorkbook 'classeur destination
Set wb2 = ActiveWorkbook 'classeur source
    For i = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(i) = True Then
            ReDim Preserve MyArray(X)
            MyArray(X) = Me.ListBox1.List(i)
            X = X + 1
        End If
    Next
           
    'Au total 13 plages à copier
    wb2.Ws(MyArray(X)).Range("V1:AB1").Copy
    wb1.Ws(Formulaire).Range("V1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, transpose:=False
    ' Après la copie des 13 plages
    
    '----------------------------------------------------
        'lancer la macro: Archiver
        'puis la macro: Nouvelle_rencontre
    '----------------------------------------------------
    
    'continuer la boucle sur les autres feuilles.
        
    With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    End With
End Sub

Edit: je sais cela n'est pas bien pour le clavier, le seul avantage maintenant j'en ai un neuf.
 

Pièces jointes

  • Piga25.xls
    57 KB · Affichages: 121
Dernière édition:

Modeste

XLDnaute Barbatruc
Re : VBA : Copier des plages avec une boucle sur plusieurs feuilles figurant dans Lis

Salut Patrick, piga25, la Suisse et ses environs,

Mes condoléances aux proches de ton clavier! :(
Je me suis dit que te laisser dans cet état allait t'obliger à racheter un second clavier le même jour ... pensons à la planète, que diable! Au pire, ce message fera "remonter" le tien ...

J'avoue ne pas trop bien comprendre ce que tu veux faire (oui, je sais tu meurs d'envie de mordre ta souris, maintenant):
  • Il reste une instruction OptionButton1 = True à l'initialisation ... mais point d'OptionButton dans ton UserForm :confused:
  • Tu évoques 2 workbooks ... mais il n'y en a qu'un qui nous soit connu :confused:
  • Avec un seul classeur ouvert, Set wb1 = ThisWorkbook et Set wb2 = ActiveWorkbook ... ben les deux aboutissent au même résultat, me semble-t-il!?
  • Le tableau est une possibilité pour stocker les noms des feuilles sélectionnées ... mais une fois ton tableau "garni", il faudra une seconde boucle pour traiter les données et faire tes copies. On ne peut pas faire les copies dans la première boucle directement?
  • Si tu utilises le tableau, la dernière instruction de ta boucle, c'est X = X + 1 ...donc à la sortie de ta boucle, si tu écris MyArray(X), tu es "hors limites"du tableau
  • Tes variables ws ne sont pas initialisées et donc Ws(MyArray(X)) ... ne correspond pas à grand chose

Avec ce que j'ai compris, ce qui suit permettrait de copier dans la feuille "Formulaire" en V1, puis V2, le contenu de la plage V1:AB1 de chaque feuille sélectionnée dans ta ListBox ... mais je n'ai sans doute pas tout compris!?
VB:
Private Sub CommandButton1_Click()
Dim i As Integer

    For i = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(i) = True Then
            Sheets(Me.ListBox1.List(i)).Range("V1:AB1").Copy
            Sheets("Formulaire").Range("V1").Offset(i, 0).PasteSpecial Paste:=xlPasteValues
        End If
    Next
End Sub
 

piga25

XLDnaute Barbatruc
Re : VBA : Copier des plages avec une boucle sur plusieurs feuilles figurant dans Lis

Re,

Merci pour les condoléances pour les restes du clavier.

1- Il reste une instruction OptionButton1 = True à l'initialisation ... mais point d'OptionButton dans ton UserForm
C'est un oubli, j'ai oublié de l'enlever du code lorsque je l'ai supprimé de l'userform.
2- Tu évoques 2 workbooks ... mais il n'y en a qu'un qui nous soit connu
Le premier est le classeur contenant la macro et c'est dans celui-la que je dois copier les données du second classeur. Ce second classeur est ouvert grace au commandbutton1, peut importe le nom. Il contient des feuilles presque similaires à la feuille formulaire. C'est la raison pour laquelle je souhaite copier ses données. C'est une mise à jour vers une nouvelle version de mes fichiers.
En espérent avoir été un peu plus clair.
Merci.

Nota: comme je n'ai pas de souris de rechange, je fais attention ....

Edit: Complément information

3- Le tableau est une possibilité pour stocker les noms des feuilles sélectionnées
C'est ce que je pense, mais là je suis totalement ignorant.

4- Pour les variables des deux classeurs, je pensais qu'en metant pour:
wb1 = thisworkbook cela concernait le classeur ou se trouvait la macro.
wb2 = activeworkbook cela concernait le classeur que je venais d'ouvrir a l'aide du CommandButton4

Le but de cet USF est de:
a- chercher un fichier donné à l'aide de l'explorateur.
b- ouvrir ce dit fichier
c- afficher les feuilles qu'il contient

Jusque là aucun problème, le code commandButton4 le réalise. C'est ensuite que cela se complique, du moins pour moi.

d- Selectionner les feuilles à copier
e- Mettre à blanc la feuille formulaire du fichier destination (macro: Nouvelle_rencontre)
f- Copier les données de certaines plage dans la première feuille sélectionnée dans cette listBox
g- Archiver la copie dans le fichier destination (macro: Archiver)
h- Remettre à blanc la feuille Formulaire du fichier destination (macro: Nouvelle_rencontre)
i- Boucler sur la seconde feuille, puis la suivante...
j- Fermer le fichier source
k- Sauvegarder le fichier destination

Je vais vous joindre une copie très alégée de deux fichiers ancienne (classeur source) et nouvelle version (classeur destination).

Merci.
 
Dernière édition:

piga25

XLDnaute Barbatruc
Re : VBA : Copier des plages avec une boucle sur plusieurs feuilles figurant dans Lis

Bonjour,

J'arrive jusqu'à la séquence "d" (comme indiqué dans précédent post), c'est après que cela bug.

Je pense que les variables pour les classeurs sont bien définies (si j'ai tout faux, c'est que je n'ai rien compris):
- wb1 = thisWorkbook (c'est à dire le nom du classeur ou se trouve le code: classeur destination)
- wb2 = ActiveWorkbook (c'est à dire le classeur que l'on vient d'ouvrir, classeur source, et qui est actif, c'est sur celui-la qu'il faut choisir les feuilles à copier).

Après je pense que le Array sur les feuilles correspond bien à deux tableaux, le premier la liste complète et le second uniquement les feuilles sélectionnées.

Le problème est comment bien définir dans une boucle, la copie de certaines plages des feuilles du classeur wb2 pour les intégrer dans la feuille "Formulaire" du classeur "Destination" (wb1).
On traite la première feuille sélectionnée du classeur source wb1, puis la seconde, etc...
 

Pièces jointes

  • Destination.xlsm
    630.1 KB · Affichages: 592
  • Source.xlsm
    713 KB · Affichages: 416
  • Destination.xlsm
    630.1 KB · Affichages: 828
  • Source.xlsm
    713 KB · Affichages: 427
  • Destination.xlsm
    630.1 KB · Affichages: 777
  • Source.xlsm
    713 KB · Affichages: 401

Modeste

XLDnaute Barbatruc
Re : VBA : Copier des plages avec une boucle sur plusieurs feuilles figurant dans Lis

Bonjour Patrick :)

Avec les explications ajoutées cette nuit, puis les fichiers ajoutés en fin de matinée, je confirme que les affectations à tes deux variables wb1 et wb2 sont correctes (si le fichier "Source" est bien celui qui est actif au moment de l'affectation, comme tu le soulignes)
Dans ton dernier message, tu parles d'un Array qui correspond à deux tableaux (pas bien compris :confused:)
Si la référence à l'OptionButton a été supprimée, on peut l'oublier joyeusement!

Restent 2 soucis:
  • la variable Ws est déclarée As WorkSheet. Cependant au moment où tu écris
    Code:
    wb2.Ws(MyArray(X)).Range("V1:AB1").Copy
    ... Ws vaut ... Nothing.
    Donc, soit tu lui attribues une référence à une feuille, en écrivant
    Code:
    Set Ws = wb2.Sheets(MyArray(X))
    auquel cas, tu pourras ensuite écrire quelque chose comme
    Code:
    Ws.Range("V1:AB1").Copy
    ... Ou alors, tu te passes de cette variable et tu écris directement
    Code:
    wb2.Sheets(MyArray(X)).Range("V1:AB1").Copy

  • l'utilisation de la variable X après la boucle For n'est (à mon sens) pas possible: imaginons que tu sélectionnes deux feuilles dans ta ListBox1 ... Quand tu cliques ensuite sur "Copie les feuilles sélectionnées", tu redimensionnes ton tableau "MyArray" et tu y stockes les noms de feuilles sélectionnées. A la fin de la boucle, MyArray(0) contient le nom d'une des feuilles et MyArray(1) le nom de la seconde. La dernière instruction de ta boucle est
    Code:
    X = X + 1
    ... X vaut donc 2. Or à la ligne suivante, tu écris MyArray(X), comme on écrirait MyArray(2) ... mais cet emplacement n'existe pas!
    Pour autant que j'aie bien compris, je ne peux donc que confirmer mes pistes d'hier: soit tu refais une seconde boucle (la première servant à "garnir" le tableau des noms de feuilles et la seconde à les passer en revue, pour copier les données). Soit tu fais directement le travail de copie dans la première (et unique) boucle

Pour la suite, je ne sais pas si ce serait ta macro Archiver qui copierait les 13 plages ... ou si c'est pour copier les 13 plages en question que tu as besoin d'un coup de main? Si la seconde hypothèse est la bonne, il faudrait que tu précises quelles plages.

Le petit bout de code proposé hier ne t'inspire pas du tout?
 

piga25

XLDnaute Barbatruc
Re : VBA : Copier des plages avec une boucle sur plusieurs feuilles figurant dans Lis

Bonjour le Forum
Salut Modeste

Je viens de faire un essai avec ton code, Il m'inspire beaucoup. Merci
Je l'ai complété et c'est presque cela. Il fonctionne pour une seule feuille mais pas avec une boucle lorsqu'il y a plusieurs feuilles de sélectionnées dans la listeBox.
Ci joint le fichier. J'ai complété le code pour copier les données que je souhaite copier.
Nota: j'ai été obligé de déplacer les codes : Archiver et Effacer de la feuille formulaire dans un module.

Il reste le problème du cas de sélection multiple dans la listeBox.

VB:
Private Sub CommandButton1_Click()
Dim wb1 As Workbook, wb2 As Workbook, Ws As Worksheet
Dim MyArray() As String
Dim i As Integer, X As Byte
TextBox2 = ThisWorkbook.Name
TextBox3 = ActiveWorkbook.Name
Set wb1 = ThisWorkbook 'classeur destination
Set wb2 = ActiveWorkbook 'classeur source
    For i = 0 To Me.ListBox1.ListCount - 1
         If Me.ListBox1.Selected(i) = True Then
           With wb1
           Effacer
           End With
             Sheets(Me.ListBox1.List(i)).Range("V1:AB1").Copy 'nom rencontre
             wb1.Sheets("Formulaire").Range("V1").PasteSpecial Paste:=xlPasteValues
             
             Sheets(Me.ListBox1.List(i)).Range("T2").Copy 'Classement ou Direct
             wb1.Sheets("Formulaire").Range("T2").PasteSpecial Paste:=xlPasteValues
             
             Sheets(Me.ListBox1.List(i)).Range("V3:AB3").Copy 'date
             wb1.Sheets("Formulaire").Range("V3").PasteSpecial Paste:=xlPasteValues
             
             Sheets(Me.ListBox1.List(i)).Range("V5:AB5").Copy 'arbitre
             wb1.Sheets("Formulaire").Range("V5").PasteSpecial Paste:=xlPasteValues
    
            Sheets(Me.ListBox1.List(i)).Range("G3").Copy 'tirage 1 ou 4
            wb1.Sheets("Formulaire").Range("G3").PasteSpecial Paste:=xlPasteValues
    
            Sheets(Me.ListBox1.List(i)).Range("I3:Q6").Copy 'joueurs équipe A
            wb1.Sheets("Formulaire").Range("I3").PasteSpecial Paste:=xlPasteValues
    
            Sheets(Me.ListBox1.List(i)).Range("AH1:AO1").Copy 'pays visiteur
            wb1.Sheets("Formulaire").Range("AH1").PasteSpecial Paste:=xlPasteValues
             
            Sheets(Me.ListBox1.List(i)).Range("AG3:AO6").Copy 'joueur équipe B
            wb1.Sheets("Formulaire").Range("AG3").PasteSpecial Paste:=xlPasteValues
             
            Sheets(Me.ListBox1.List(i)).Range("W10:Y18").Copy 'durées
            wb1.Sheets("Formulaire").Range("W10").PasteSpecial Paste:=xlPasteValues
    
            Sheets(Me.ListBox1.List(i)).Range("C10:C18").Copy 'remplaçant équipe A
            wb1.Sheets("Formulaire").Range("C10").PasteSpecial Paste:=xlPasteValues
        
            Sheets(Me.ListBox1.List(i)).Range("AS10:AS18").Copy 'remplaçant équipe B
            wb1.Sheets("Formulaire").Range("AS10").PasteSpecial Paste:=xlPasteValues
             
            Sheets(Me.ListBox1.List(i)).Range("B22:AT22").Copy '1ère ligne des changements ou temps
            wb1.Sheets("Formulaire").Range("B24").PasteSpecial Paste:=xlPasteValues
             
            Sheets(Me.ListBox1.List(i)).Range("B28:AT28").Copy '2ème ligne ligne changement ou temps
            wb1.Sheets("Formulaire").Range("B32").PasteSpecial Paste:=xlPasteValues
             
            Sheets(Me.ListBox1.List(i)).Range("B24:AT25").Copy '1ère double ligne des touches
            wb1.Sheets("Formulaire").Range("B27").PasteSpecial Paste:=xlPasteValues
             
            Sheets(Me.ListBox1.List(i)).Range("B30:AT31").Copy '2ème double ligne des touches
            wb1.Sheets("Formulaire").Range("B35").PasteSpecial Paste:=xlPasteValues
         
         End If
         With wb1
         Archiver
         End With
     Next
         
    With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    End With
End Sub
 

Pièces jointes

  • Destination.xlsm
    630.5 KB · Affichages: 163
  • Destination.xlsm
    630.5 KB · Affichages: 200
  • Destination.xlsm
    630.5 KB · Affichages: 142
Dernière édition:

Modeste

XLDnaute Barbatruc
Re : VBA : Copier des plages avec une boucle sur plusieurs feuilles figurant dans Lis

Salut Patrick ... et puis tous les autres,

J'ai encore trois questions:
- dans ta boucle "For i = 0 To Me.ListBox1.ListCount - 1" pourquoi la procédure Effacer est-elle appelée uniquement pour les feuilles sélectionnées dans la ListBox, alors que la procédure Archiver est, quant à elle, appelée pour chaque nom de feuille dans la liste (sélectionné ou non)? L'appel à la première est dans le "If Me.ListBox1.Selected(i) = True"; l'autre se fait en-dehors :confused:

- dans les deux procédures évoquées ci-dessus, une des premières instructions est un test ("If [D1] <> "") dans l'une et une affectation ("[D1] = """) dans l'autre ... Il doit s'agir de la cellule D1 de quelle feuille et de quel classeur?
On est d'accord que si tu écris
Code:
With wb1
Effacer
End With
... ce n'est pas une façon de dire que la procédure en question doit s'appliquer au classeur représenté par wb1? Donc, par défaut, le [D1] dans chaque procédure est la cellule D1 de la feuille active au moment où le programme entre dans cette procédure.

- parmi les plages que tu copies figurent une série de références sous la forme V1:AB1. Pour celle-ci, ainsi que l'une ou l'autre (pas tout vérifié :eek:) il s'agit de cellules fusionnées. Es-tu certain qu'il faille renseigner toute la plage à chaque fois? La cellule en haut à gauche d'une plage fusionnée (ici V1) devrait suffire, non?
 

piga25

XLDnaute Barbatruc
Re : VBA : Copier des plages avec une boucle sur plusieurs feuilles figurant dans Lis

Bonjour le Forum, Modeste

Merci pour l'intérêt que tu me porte.

1- Les deux procédures "Effacer" et "Archiver" doivent être appelées que pour les feuilles sélectionnées.
Je comprends mieux pourquoi il y avait un bug avec la procédure "Archiver".
Pour moi les deux doivent se faire dans le "If Me.ListBox1.Selected(i) = True". Une au début afin de mettre la feuille Formulaire vierge de donnée et de lui attribuer un n° d'ordre. La seconde en fin, afin de sauvgarder les données qui viennent d'être copier, puis même procédure avec la seconde feuille sélectionnée.

2- Il s'agit de la cellule "[D1]" de la feuille "Formulaire" du classeur "Destination", celui qui contient l'userform avec le code.
Le but est de vérifier lorsque l'on fait "Archiver" s'il n'y a pas de numéro dans la feuille d'en attribuer un. Le second c'est lorsque l'on fait "Effacer", c'est à dire que l'on veut créer une nouvelle rencontre, d'effacer le numéro existant et de prendre le numéro suivant , c'est à dire si déjà 8 rencontres de renseigner, de prendre le numéro 9.
Lorsque j'entre les rencontres manuellement, c'est à dire que je renseigne moi même la feuille formulaire, cela fonctionne bien par contre lorsque je récupère des rencontre sur le fichier "Source" par exemple cela ne fonctionne pas correctement. En effet dans le classeur "Source" le numéro de la rencontre ne sera pas forcément le numéro qui doit venir en suivant dans la liste des rencontres.

3- Oui il s'agit de plages fusionnées. J'ai toujours procédé de la sorte. Il est vrai lorsque l'on saisie une plage fusionnée, c'est toujours la première cellule qui est prise en compte.
Mes plages fusionnées sont toujours sur la même ligne, jamais sur la même colonne.

Cordialement
 

Modeste

XLDnaute Barbatruc
Re : VBA : Copier des plages avec une boucle sur plusieurs feuilles figurant dans Lis

Re,

Pour moi les deux doivent se faire dans le "If Me.ListBox1.Selected(i) = True". Une au début afin de mettre la feuille Formulaire vierge de donnée et de lui attribuer un n° d'ordre. La seconde en fin [...]
... c'est également ce que je testerais :)


Il s'agit de la cellule "[D1]" de la feuille "Formulaire" du classeur "Destination
... et on est d'accord que, lorsque tu appelles la procédure Effacer, la feuille active n'est pas celle-là!? (pas plus que ce classeur-là non plus! :eek:
Il me semble que dans Effacer et Archiver, il faudrait "préfixer" [D1] avec un "ThisWorkbook.Sheets("Formulaire").[D1]"


Lorsque j'entre les rencontres manuellement, c'est à dire que je renseigne moi même la feuille formulaire, cela fonctionne bien par contre lorsque je récupère des rencontre sur le fichier "Source" par exemple cela ne fonctionne pas correctement. En effet dans le classeur "Source" le numéro de la rencontre ne sera pas forcément le numéro qui doit venir en suivant dans la liste des rencontres.
... Pas encore regardé cet partie-là. Je propose qu'on y revienne après, si besoin (d'autant qu'il n'est pas impossible qu'il y ait un lien avec le point qui précède :confused:)
 

piga25

XLDnaute Barbatruc
Re : VBA : Copier des plages avec une boucle sur plusieurs feuilles figurant dans Lis

RE,

Tu vas plus que moi et c'est très bien.
J'essais de suivre afin de tout comprendre, pas si facile que cela le VBA.
J'espère qu'a la fin j'arriverai à tout reproduire sans aide.

... et on est d'accord que, lorsque tu appelles la procédure Effacer, la feuille active n'est pas celle-là!? (pas plus que ce classeur-là non plus! :eek:
Il me semble que dans Effacer et Archiver, il faudrait "préfixer" [D1] avec un "ThisWorkbook.Sheets("Formulaire").[D1]"
Oui c'est bien cela, car la feuille active est bien sur le classeur "Source", celui que l'on a ouvert avec l'aide de l'Userform. Donc si j'ai bien tout compris la commande doit être comme tu le dis "ThisWorkbook.Sheets("Formulaire").[D1]" car la cellule "[D1]" est bien le classeur "Destination" celui qui contien la macro.
 

Modeste

XLDnaute Barbatruc
Re : VBA : Copier des plages avec une boucle sur plusieurs feuilles figurant dans Lis

Re,

(je te jure que si je vais trop vite, ce n'est pas exprès ... et pas vraiment dans mes habitudes)
Prends ton temps, je vais bouquiner un peu ou faire un tour au jardin ...

Un exemple de l'utilisation de 'With' au travers de la procédure Effacer
VB:
Sub Effacer()
  Application.ScreenUpdating = False
  If MsgBox("Voulez vous réellement effacer les données de la feuille ?", vbYesNo + vbCritical + vbDefaultButton2, "") = vbNo Then Exit Sub
  With ThisWorkbook.Sheets("Formulaire")
    .Unprotect
    .[D1] = ""
    .Range("Match45") = ""
    .Range("Rencontre45") = ""
    .Range("Temps45") = ""
    .[D1].Select
    .[D1] = ThisWorkbook.Sheets("Archives").Range("A" & ThisWorkbook.Sheets("Archives").Cells(Rows.Count, 1).End(xlUp).Row).Value + 1
    .Protect
  End With
End Sub
... au passage, je propose de déplacer le 'Unprotect', comme ci-dessus (sinon tu déprotèges avant de savoir s'il y aura des modifs et, s'il n'y en a pas, tu ne re-protèges pas)
 

piga25

XLDnaute Barbatruc
Re : VBA : Copier des plages avec une boucle sur plusieurs feuilles figurant dans Lis

RE,

Non je suis pour le moment, en plus il pleut et fait froid, donc je reste derrière l'ordi avec mon clavier tout beau tout neuf. La touche F1 fonctionne à merveille, elle n'est pas encore usée.

Bien le déplacement du Unprotect - Protect à l'intérieur du With - End With.
Je pensais qu'en déprotégeant la feuille en début et qu'une fois arrivée à la fin il suffisait de la reprotéger, qu'il y ai modif ou non. J'ai noté la subtilité.
 
Dernière édition:

piga25

XLDnaute Barbatruc
Re : VBA : Copier des plages avec une boucle sur plusieurs feuilles figurant dans Lis

Bonjour le Forum, Luc

J'avance un peu mais ce n'st pas encore cela.

Un peu d'info sur le fonctionnement.
Normalement prévu pour entrer directement les rencontres au fur et à mesure où elles se déroulent. La saisie se fait uniquement sur la feuille formulaire du fichier Destination. Seules les cellules sur fond vert sont à renseigner. Pour le comptage des touches, cela se passe dans les deux tableaux du bas et uniquement par double clic.
Une fois la rencontre terminée, elle est archivée au moyen du bouton archiver.
C'est la modification majeur que j'ai effectué entre la première version et celle-ci. Auparavant je créais autant de feuilles que de rencontres, trop lourd à gérer.

Le but de ma demande est donc de pouvoir récupérer toutes les rencontres déjà renseignées (il y en a beaucoup) d'ou mon intérêt d'automatiser cela.
Les feuilles de saisies des deux versions étant pratiquement similaires, je récupère les données pour les copier sur la feuille formulaire et une fois celle-ci complète elle est archivée, puis de nouveau avec la feuille suivante (dans un fichier il peu y en avoir plus de 50 feuilles à traiter.

Voila pour l'explication de ma demande.

--------------------------------------------------------------------------------------------------------------

Comme dit en MP voici ou je coince;

VB:
Private Sub CommandButton1_Click()
Dim wb1 As Workbook, wb2 As Workbook, Ws As Worksheet
Dim MyArray() As String
Dim i As Integer, X As Byte
TextBox2 = ThisWorkbook.Name
TextBox3 = ActiveWorkbook.Name
Set wb1 = ThisWorkbook 'classeur destination
Set wb2 = ActiveWorkbook 'classeur source
    For i = 0 To Me.ListBox1.ListCount - 1
         If Me.ListBox1.Selected(i) = True Then
           
             Sheets(Me.ListBox1.List(i)).Range("V1").Copy 'nom rencontre
             wb1.Sheets("Formulaire").Range("V1").PasteSpecial Paste:=xlPasteValues
             Sheets(Me.ListBox1.List(i)).Range("T2").Copy 'Classement ou Direct
             wb1.Sheets("Formulaire").Range("T2").PasteSpecial Paste:=xlPasteValues
             Sheets(Me.ListBox1.List(i)).Range("V3").Copy 'date
             wb1.Sheets("Formulaire").Range("V3").PasteSpecial Paste:=xlPasteValues
             Sheets(Me.ListBox1.List(i)).Range("V5").Copy 'arbitre
             wb1.Sheets("Formulaire").Range("V5").PasteSpecial Paste:=xlPasteValues
            Sheets(Me.ListBox1.List(i)).Range("G3").Copy 'tirage 1 ou 4
            wb1.Sheets("Formulaire").Range("G3").PasteSpecial Paste:=xlPasteValues
            Sheets(Me.ListBox1.List(i)).Range("I3:Q6").Copy 'joueurs équipe A
            wb1.Sheets("Formulaire").Range("I3").PasteSpecial Paste:=xlPasteValues
            Sheets(Me.ListBox1.List(i)).Range("AH1").Copy 'pays visiteur
            wb1.Sheets("Formulaire").Range("AH1").PasteSpecial Paste:=xlPasteValues
            Sheets(Me.ListBox1.List(i)).Range("AG3:AO6").Copy 'joueur équipe B
            wb1.Sheets("Formulaire").Range("AG3").PasteSpecial Paste:=xlPasteValues
            Sheets(Me.ListBox1.List(i)).Range("W10:Y18").Copy 'durées
            wb1.Sheets("Formulaire").Range("W10").PasteSpecial Paste:=xlPasteValues
            Sheets(Me.ListBox1.List(i)).Range("C10:C18").Copy 'remplaçant équipe A
            wb1.Sheets("Formulaire").Range("C10").PasteSpecial Paste:=xlPasteValues
            Sheets(Me.ListBox1.List(i)).Range("AS10:AS18").Copy 'remplaçant équipe B
            wb1.Sheets("Formulaire").Range("AS10").PasteSpecial Paste:=xlPasteValues
            Sheets(Me.ListBox1.List(i)).Range("B22:AT22").Copy '1ère ligne des changements ou temps
            wb1.Sheets("Formulaire").Range("B24").PasteSpecial Paste:=xlPasteValues
            Sheets(Me.ListBox1.List(i)).Range("B28:AT28").Copy '2ème ligne ligne changement ou temps
            wb1.Sheets("Formulaire").Range("B32").PasteSpecial Paste:=xlPasteValues
            Sheets(Me.ListBox1.List(i)).Range("B24:AT25").Copy '1ère double ligne des touches
            wb1.Sheets("Formulaire").Range("B27").PasteSpecial Paste:=xlPasteValues
            Sheets(Me.ListBox1.List(i)).Range("B30:AT31").Copy '2ème double ligne des touches
            wb1.Sheets("Formulaire").Range("B35").PasteSpecial Paste:=xlPasteValues
                                 
         End If

         With wb1
         Archiver
         End With

     Next
         
    With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    End With
    
    Unload Me
    
End Sub
Partie posant soucis :
End If
With wb1
Archiver
End With
Next

Sans cela, le code fonctionne mais pour copier qu'une seule feuille.
J'ai l'impression que lorsqu'il y a plusieurs feuilles de sélectionner, il ne copie pas les bonnes données. Cela ne doit pas faire la bascule d'un fichier à l'autre.
Une fois les données copier, on devrait pouvoir voir le basculement de fichier, c'est a dire rendre le fichier destination actif, puis revenir sur le fichier Source et recommencer une nouvelle boucle.
Ou alors, laisser toujours le fichier Destination actif, et copier en fond sur le fichier Source. Je ne sais pas si je m'explique bien sur cela. Le problème doit se situer à ce niveau là je pense.

Cordialement Patrick
 

Pièces jointes

  • Destination.xlsm
    633.7 KB · Affichages: 159
  • Source.xlsm
    713.4 KB · Affichages: 328
  • Destination.xlsm
    633.7 KB · Affichages: 113
  • Source.xlsm
    713.4 KB · Affichages: 399
  • Destination.xlsm
    633.7 KB · Affichages: 168
  • Source.xlsm
    713.4 KB · Affichages: 443
Dernière édition:

Modeste

XLDnaute Barbatruc
Bonsoir Patrick et puis tous les autres,

Pas tout regardé, mais contrairement à ce que tu sembles croire, je serais tenté de dire que la copie se fait correctement, dans ta feuille formulaire (à condition de mettre provisoirement en commentaire, l'appel à la procédure "Archiver")
... pas certain à 100%, mais en comparant le contenu de cette feuille "Formulaire" avec celui de la dernière feuille sélectionnée dans la ListBox (donc du fichier Source), les données me paraissent cohérentes!?

Par contre, n'étions-nous pas tombés d'accord sur le fait que l'appel à la procédure "Archiver" devait figurer avant le End If, de manière qu'elle ne concerne que les feuilles sélectionnées, plutôt que de s'exécuter à chaque passage dans la boucle?
D'autre part, dans cette même procédure, on trouve aussi des références à [D1] (qui me semble aussi orpheline que sa soeur dans la procédure "Effacer", précédemment modifiée)

J'essaierai (demain, hein, pas maintenant :rolleyes:) de comprendre le fonctionnement de la Sub Archiver

Bonne fin de soirée,

Edit: question de dernière minute ... dans cette proc Archiver, je ne vois aucune mention à la feuille Formulaire ... ce n'est pas celle-là que tu archives :confused:
 
Dernière édition:

piga25

XLDnaute Barbatruc
Re : VBA : Copier des plages avec une boucle sur plusieurs feuilles figurant dans Lis

Re,

Je crois savoir pourquoi il ni a aucune mention à la feuille Formulaire dans la procédure Archiver, au départ cette procédure était dans la feuille Formulaire, je l'ai déplacée dans un module. Je n'aurai pas du le faire il semble t il.
 

Discussions similaires

Réponses
17
Affichages
826

Membres actuellement en ligne

Statistiques des forums

Discussions
312 196
Messages
2 086 101
Membres
103 116
dernier inscrit
kutobi87