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

piga25 · 28 Mars 2013

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.

piga25 · 3 Avril 2013

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

Bonjour le forum, klin89

Si je n'ai pas défini les deux classeurs, c'est que le nom de ceux ci peut changer, surtout pour le classeur source. Ce dernier étant recherché à l'aide de l'explorateur windows.
Les codes sont dans un fichier modèle qui lui par la suite prendra le nom des catégories des joueurs et des armes employées.

piga25 · 3 Avril 2013

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

Bonjour le forum, Luc

Après avoir passé le fichier à la "moulinette", je n'ai pas trouvé de bug. Tout semble bien fonctionner. Un barbatruc de merci Luc. Tu m'as enlevé une grosse épine du pied

J'ai enlevé quelques lignes de code qui ne servaient plus et en ai commenté d'autres.

Si je peux me permettre, comme tu le suggérais au post #16 :

Modeste à dit:
Quand on en aura terminé avec ce point, il faudra qu'on essaie de voir si on ne pourrait pas simplifier la partie du code où tu copies les valeurs d'une feuille à l'autre ... mais à chaque jour suffit sa peine, comme on dit

J'ai mis un MsgBox Timer en fin de procédure, juste pour voir combien de temps cela mettait pour copier une seule feuille, cela va de 8 à 10 secondes.
Ma question est : Y a t'il une autre façon de faire de le copier coller; qui semble dans ce cas là assez long?

Modeste · 3 Avril 2013

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

Bonjour Patrick, le forum,

Y a t'il une autre façon de faire de le copier coller

Certainement! Une des plus rapide est l'utilisation de tableaux pour stocker les valeurs ... dans le cas présent, il faudra voir si j'en suis capable (!?) et si c'est possible: cellules non-contiguës, plage verticale à transposer à l'horizontale et/ou l'inverse, etc.

... Avant d'aller plus loin: dans la procédure "Archiver" pour la copie des durées de match et des remplaçants, on recopie trois fois la dernière cellule à chaque fois (W18, C18 & AS18) ... c'est normal

piga25 · 3 Avril 2013

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

Bonjour le Forum, Luc

Modeste à dit:
... Avant d'aller plus loin: dans la procédure "Archiver" pour la copie des durées de match et des remplaçants, on recopie trois fois la dernière cellule à chaque fois (W18, C18 & AS18) ... c'est normal

Non ce n'est pas normal, il faut lire W18,W19 et W20 puis C18, C19 et C20 et enfin AS18, AS19 et AS20.
lorsque j'ai rajouté ces lignes, j'ai bien mis les bonnes destinations mais j'ai homis de mettre les bonnes origines.
Comme dans tous mes tests je n'avais pas renseigné les durées des matchs je n'ai pas remarqué cette stupidité.

Modeste · 3 Avril 2013

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

Re,

Ben mon cochon, j'ai l'impression d'avoir participé à un jeu de piste ... dans un environnement inconnu! Le contenu de la cellule V1 de la feuille "heidenheim 5-8 2013" doit être recopié en H33 de feuille "Formulaire", pour ensuite apparaître en G16 de la feuille "Archives", etc.
Je suis "descendu" de ... pas beaucoup: un peu plus de 16 secondes pour 3 feuilles J'ai utilisé un tableau au seul endroit où ça m'a paru possible.
Il me semble que le résultat en feuille "Recap" n'est pas tout à fait correct, mais je n'ai plus les yeux en face des trous, à force. Je compte donc sur toi pour repérer les erreurs ...
Edit: je pense avoir trouvé celle de la feuille "Recap". Code corrigé ci-dessous.

Voici le code de la procédure "Archiver":

VB:

Sub Archiver()
  Set TBa = ThisWorkbook.Sheets("Archives")
  Set tbr = ThisWorkbook.Sheets("Recap")
  Set ff = ThisWorkbook.Sheets("Formulaire")
  Application.ScreenUpdating = False
  If ff.[D1] <> "" Then 'Si présence de numéro de dossier
    Set ZZ = TBa.Columns(1).Find(ff.[D1], , , xlWhole)
    If ZZ Is Nothing Then
        l = TBa.Cells(Rows.Count, 1).End(xlUp).Row + 1 'Ligne pour nouvelle entrée
    Else
        l = ZZ.Row
        If MsgBox("Voulez vous le modifier ?", vbYesNo + vbDefaultButton2, "Ce numéro de RENCONTRE existe déjà !") = 7 Then Exit Sub 'Ne pas remplacer l'entrée existante
    End If
    '===============Copie de toutes les données dans feuille Archive

    Set ZZ = TBa.Cells(l, 1)

    tableCible = Array("D1", "V1", "V3", "V5", "T2", "G3", "I3", "I4", "I5", "I6", "AH1", "AG3", "AG4", "AG5", "AG6", "W10", "W11", "W12", "W13", "W14", "W15", "W16", "W17", "W18", "W19", "W20", "C10", "C11", "C12", "C13", "C14", "C15", "C16", "C17", "C18", "C19", "C20", "AS10", "AS11", "AS12", "AS13", "AS14", "AS15", "AS16", "AS17", "AS18", "AS19", "AS20")
    For i = 0 To UBound(tableCible)
        ZZ.Offset(0, i).Value = ff.Range(tableCible(i))
    Next i
    ZZ.Offset(0, 48).Resize(1, 45).Value = ff.Range("B24:AT24").Value
    ZZ.Offset(0, 93).Resize(1, 45).Value = ff.Range("B32:AT32").Value
    ZZ.Offset(0, 138).Resize(1, 45).Value = ff.Range("B27:AT27").Value
    ZZ.Offset(0, 183).Resize(1, 45).Value = ff.Range("B35:AT35").Value
    ZZ.Offset(0, 228).Resize(1, 45).Value = ff.Range("B28:AT28").Value
    ZZ.Offset(0, 273).Resize(1, 45).Value = ff.Range("B36:AT36").Value
    ZZ.Offset(0, 318).Resize(1, 45).Value = ff.Range("B26:AT26").Value
    ZZ.Offset(0, 363).Resize(1, 45).Value = ff.Range("B34:AT34").Value
    ZZ.Offset(0, 408).Resize(1, 45).Value = ff.Range("B29:AT29").Value
    ZZ.Offset(0, 453).Resize(1, 45).Value = ff.Range("B37:AT37").Value

'    '====================Inscription des données dans la feuille RECAP
    With ThisWorkbook.Sheets("Recap")
        .Unprotect
        .[D1] = ff.[D1]
        tbr.Range("A" & tbr.[D2]) = ff.[D1]
        Set ZZ = tbr.Columns(1).Find(ff.[D1], , , xlWhole)
        If ZZ Is Nothing Then
            l = tbr.Cells(Rows.Count, 1).End(xlUp).Row + 1 'Ligne pour nouvelle entrée
        Else
            l = ZZ.Row
        End If
        
        Set ZZ = tbr.Cells(l, 1)
        ZZ.Value = ff.[D1].Value
        
        'Création de la boucle pour les 11 rencontres du match
        Dim tablo(0 To 10, 0 To 14)
        For k = 0 To 10
            tablo(k, 0) = ff.[V3] 'Inscription de la date de la rencontre
            tablo(k, 1) = ff.[V1] 'Inscription lieu de rencontre
            tablo(k, 2) = ff.Range("B" & 10 + k) 'Inscription n° dans match
            tablo(k, 3) = ff.[J1] 'Inscription du pays
            tablo(k, 4) = ff.Range("C" & 10 + k) 'Inscription du titulaire ou remplaçant
            tablo(k, 5) = ff.Range("E" & 10 + k) 'Inscription des noms des participants
            tablo(k, 6) = ff.Range("W" & 10 + k) 'Inscription de la durée du match
            tablo(k, 7) = ff.Range("S" & 10 + k) 'Inscription des touches données
            tablo(k, 8) = ff.Range("AB" & 10 + k) 'Inscription des touches reçues
            tablo(k, 9) = ff.Range("AV" & 10 + k) 'Inscription de l'indice
            tablo(k, 10) = ff.Range("AX" & 10 + k) 'Match gagné, perdu ou nul
            tablo(k, 11) = ff.Range("AS" & 10 + k) 'Inscription du titulaire ou remplaçant pays adversaire
            tablo(k, 12) = ff.Range("AJ" & 10 + k) 'Inscription des noms des participants
            tablo(k, 13) = ff.[AH1] 'Inscription du pays adversaire
            tablo(k, 14) = ff.[T2] 'Inscription Direct ou Classement
        Next
        ZZ.Offset(0, 1).Resize(11, 15).Value = tablo ' ligne modifiée --> erreur
        .Protect
    End With
  Else
    MsgBox "Impossible d'archiver sans numéro de RENCONTRE", vbCritical, "Action avortée !"
  End If
End Sub

piga25 · 4 Avril 2013

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

Re,

Chapeau bas mon ami. Quel changement et rapide avec cela.
J'avoue ne pas avoir tout compris et plus particulièrement cette ligne :

ZZ.Offset(0, 1).Resize(11, 15).Value = tablo ' ligne modifiée --> erreur

Pour la feuille Archives:
Je pense avoir saisie le sens après le Array(......) . C'est à dire on met toutes les cellules isolées les unes après les autres dans un tableau puis on copie celui-ci dans la feuille archives en partant de la première colonne. Ensuite vient le tour des plages de cellules continues.
Pour la feuille Recap:
On reprend les données du Array (c'est à dire le tableau) tablo que l'on copie a leurs emplacements.

En tout cas, j'ai fait un essai sur 50 feuilles à copier et en une seule fois et cela à fonctionner.
Sauf le MsgBox Timer qui lui ma mis une valeur négative, mais ça ce n'est absolument pas grave, car en version finale il n'existera pas. Là c'était juste pour voir le temps de copie.
Pour info 3 feuilles en 9s.

Modeste · 4 Avril 2013

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

Salut Patrick, bonjour tous les autres,

Chapeau bas mon ami

Voilà qui n'est guère prudent, avec le temps qu'il fait: gardez vos couvre-chefs vissés sur la tête!!

Tant mieux si la différence de temps est significative (c'est que ma trottinette n'a rien d'une machine de guerre )

Deux mots d'explication:

un premier tableau (tableCible) est utilisé et reprend les adresses de toutes les cellules non-contiguës, dans lesquelles on doit aller chercher les valeurs. Comme on doit ensuite recopier ces valeurs sur une seule ligne (celle de ta variable ZZ), dans les cellules des colonnes voisines, une une petite boucle permet de faire l'opération (on décale d'une colonne à droite, pour chaque adresse renseignée dans le tableau "tableCible"). Ce tableau-ci n'est utilisé que pour la feuille "Archives"
viennent ensuite les copies des plages à stocker les unes à côté des autres, comme tu l'aavais compris.
pour la feuille "Recap" j'utilise un autre tableau (tablo) pour remplacer la "tripotée" de copies cellule par cellule que tu avais mise en place, en stockant toutes les valeurs dans un tableau en mémoire (j'ai conservé ta boucle For, pour le faire), puis en "déchargeant" ce tableau dans la feuille, en une seule fois. C'est ce que fait la ligne que tu as un peu de mal à comprendre ... qui est aussi celle où j'avais fait une erreur (corrigée)

ZZ.Offset(0, 1).Resize(11, 15).Value = tablo

Cliquez pour agrandir...

Au départ de ZZ, on décale d'une colonne vers la droite, en restant sur la même ligne (c'est ce Offset que j'avais oublié dans un premier temps) et on redéfinit la hauteur et la largeur de cette zone en fonction du nombre d'éléments dans le "tablo" (Resize(11, 15))

Nul doute que quelqu'un maîtrisant mieux que moi les tableaux pourrait encore faire gagner un peu de temps ... Mais c'est ce que j'ai de mieux "en magasin"

Bonne journée

piga25 · 4 Avril 2013

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

Bonjour Luc, le forum

Un très grand merci pour toutes ces explications.

J'ai compris le système our la feulle Récap avec Tablo ainsi qe l'utilité de cette fameuse ligne et pourquoi elle s trouvait après le Next.
Je me rends vraiement compte de l'utilisation des tableaux, diminuent considérablement les temps d'exécution.

Je vais essayé d'en réaliser un pour la seconde partie dans le code pour archiver, la partie ou l'on copie les plages de 45 cellules, avec une boucle ayant un pas de 45 (pas sur que cela bien clair ).

Merci pour tout Luc.

piga25 · 4 Avril 2013

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

Bonjour Luc, le forum

Mon essais s'avère non concluant,
Extrait de code :

VB:

'ZZ.Offset(0, 48).Resize(1, 45).Value = ff.Range("B24:AT24").Value 'copie la première lignes des ordres de changement
     'ZZ.Offset(0, 93).Resize(1, 45).Value = ff.Range("B32:AT32").Value 'Copie la seconde lignes des ordres de changement
     'ZZ.Offset(0, 138).Resize(1, 45).Value = ff.Range("B27:AT27").Value 'copie la première lignes des touches données
     'ZZ.Offset(0, 183).Resize(1, 45).Value = ff.Range("B35:AT35").Value 'Copie la seconde lignes des touches données
     'ZZ.Offset(0, 228).Resize(1, 45).Value = ff.Range("B28:AT28").Value 'copie la première lignes des touches reçues
     'ZZ.Offset(0, 273).Resize(1, 45).Value = ff.Range("B36:AT36").Value 'Copie la seconde lignes des touches reçues
     'ZZ.Offset(0, 318).Resize(1, 45).Value = ff.Range("B26:AT26").Value 'copie la première lignes des cartons reçus
     'ZZ.Offset(0, 363).Resize(1, 45).Value = ff.Range("B34:AT34").Value 'Copie la seconde lignes des cartons reçus
     'ZZ.Offset(0, 408).Resize(1, 45).Value = ff.Range("B29:AT29").Value 'copie la première lignes des cartons adversaire reçus
     'ZZ.Offset(0, 453).Resize(1, 45).Value = ff.Range("B37:AT37").Value 'Copie la seconde lignes des cartons adversaire reçus
 
    TabloCible = Array("B24:AT24", "B32:AT32", "B27:AT27", "B35:AT35", "B28:AT28", "B36:AT36", "B26:AT26", "B34:AT34", "B29:AT29", "B37:AT37")
    For J = 0 To UBound(TabloCicle)
        ZZ.Offset(0, J * 45).Resize(1, 48).Value = ff.Range(TabloCible(J))
    Next J

Ma variable "j" reste à "vide" car je pense qu'en tapant des plages dans le "Array" rien n'est pris en compte.
Y a t'il moyen de les prendre en compte ou faut il créer une seconde boucle de 0 à 45 pour décaler la colonne "B" en "C" .... jusqu'à "AT" ?

EDIT : Petite erreur de ma part j'ai fait une faute de frappe dans For J = 0 To UBound(TabloCicle) lire : For J = 0 To UBound(TabloCible)

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

piga25

XLDnaute Barbatruc

Pièces jointes

piga25

XLDnaute Barbatruc

piga25

XLDnaute Barbatruc

Pièces jointes

Modeste

XLDnaute Barbatruc

piga25

XLDnaute Barbatruc

Modeste

XLDnaute Barbatruc

piga25

XLDnaute Barbatruc

Modeste

XLDnaute Barbatruc

piga25

XLDnaute Barbatruc

piga25

XLDnaute Barbatruc

Discussions similaires