Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Bonjour Patrick, le fil, le forum,les cloches et les oeufs,

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 semble-t-il
Ah mais rien ne t'en empêche! (il faut montrer à ton projet qui c'est qu'est le chef ) ... Mais on en revient à un point déjà abordé: tu peux te contenter d'écrire If [D1] <> "" Then ... à condition d'être certain que [D1] est bien une cellule de la feuille et du classeur actifs.
Même chose donc, ici, que dans ton message #10 pour la référence à [D1] dans la procédure "Effacer"


Deux solutions:
  • Soit,en début de procédure, tu attribues à une variable, une référence à ton objet, avec une instruction comme "Set mapetitefeuilleadorée = Thisworkbook.Sheets("Formulaire")" (ThisWorkbook ... si et seulement si c'est bien du classeur contenant la macro qu'il s'agit) et devant chaque référence à [D1] ou à Range("V1:AB1") ou encore à Cells(2, 3), tu ajoutes mapetitefeuilleadorée.

  • Soit, tu utilises l'instruction With ... End With (comme dans mon message #11) Attention cependant que tu l'utilises déjà en fin de procédure "Archiver" puisqu'on y trouve un "With TBr".
    Dans le cas présent, donc et pour ne pas créer de confusion, j'utiliserais la première solution


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
 

piga25

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

Bonjour le forum, Luc

J'avoue ne plus rien y comprendre.
Me dire si je fais fausse route, pourquoi modifier les codes qui fonctionnent déjà sans problème, c'est à dire lorsque j'entre moi même les données sur la feuille "Formulaire", le code "Archiver" et "Effacer" (nouvelle rencontre) fonctionne bien.
Par contre lorsque j'utilise le code de USF2 "CommandButton1_Click", j'arrive bien à copier les données de la feuille qui figure dans la listbox et que l'on ajoute en fin de procédure l'instruction "Archiver" cela archive bien des données mais pas celles qui viennent d'être copier sur la feuille formulaire, il s'agit de celles figurant sur la feuille "Recap" du fichier "Source". !!!!
Ce qui fonctionne pour le moment avec USF2 :
- Selectionner le fichier
- Sélectionner une feuille
- copier la feuille sélectionner.
Arreter le code à cette endroit puis basculer manuellement sur le fichier "Destination" et "Archiver" les données qui vienne d'être copier.
En faisant comme ceci, il n'y a pas de problème avec [D1].
Pour copier une feuille faire même manip.
 

Modeste

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

Bonsoir,

Là c'est moi qui ne comprends plus rien: si le code fonctionne quand tu complètes "à la main" la feuille "Formulaire", c'est (selon moi) parce que dans ce cas, c'est forcément la feuille "Formulaire" qui est active!?
Ce que je propose, c'est de trouver un système qui permette que le code fonctionne dans les autres cas aussi
... Mais si on n'est pas sur la même longueur d'onde, il ne me reste qu'à rattraper les cloches et aller voir François à Rome.
 

piga25

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

Bonsoir le Forum, Luc

Là c'est moi qui ne comprends plus rien: si le code fonctionne quand tu complètes "à la main" la feuille "Formulaire", c'est (selon moi) parce que dans ce cas, c'est forcément la feuille "Formulaire" qui est active!?
Lorsqu'il n'y a que le classeur "Destination" qui est ouvert, c'est bien la feuille "Formulaire" qui est active.

Ce que je propose, c'est de trouver un système qui permette que le code fonctionne dans les autres cas aussi
Pour moi, je pense que c'est la meilleur solution.
Me dire si je me trompe.
Lorsque l'on recherche avec USF2 puis que l'on ouvre le classeur "Source", il faudrait que celui-ci ne soit pas actif. Il n'est pas nécessaire qu'il soit visible du moment que les feuilles qu'il contient s'affichent bien dans la listeBox. De cette façon les variables seraient : wb1 = ThisWorbook et wb2 = TextBox2.Value (je ne sais comment l'écrire).

Je te rassure, c'est plutôt moi qui est la tête en en oeuf de pâques avec rien dedant.
 

piga25

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

Re,

Je viens de constater ceci dans :

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

Cela ne va pas avec l'attribution des classeurs aux textbox.
La textbox2 contient le nom du classeur que l'on vient d'ouvrir ("Source") et non celui auquel le code appartient.
La textbox3 contient le nom du classeur qui contient le code ("Destination").
Ce qui voudrait dire que les variables wb1 et wb2 ne sont pas bonnes.

Est-ce cela?
 

Modeste

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

Bonjour Patrick, le forum,

Les variables wb1 et wb2 sont correctement initialisée (j'avais déjà vérifié et re-vérifié)
Pour le reste, j'ai l'impression qu'on tourne un peu en rond ...

Peux-tu archiver une copie de ton fichier Destination actuel et tester celui-ci:
- j'ai remis la procédure "Effacer" dans la boucle (parce que c'est dans celle-ci que tu "garnis" la désormais célèbre cellule D1 de la feuille Formuaire)
- j'ai mis en commentaires la partie de la procédure "Archiver" qui s'occupe de la feuille "Récap" (on y reviendra plus tard)
- dans la procédure "Archiver", j'ai utilisé une variable (ff) qui représente la feuille formulaire

Teste donc cette version du fichier, en cliquant sur ton bouton "Transpose" et en sélectionnant plusieurs feuilles dans ta ListBox.
Tu devrais voir apparaître le message "voulez-vous effacer le contenu ..." autant de fois qu'il y a de feuilles sélectionnées dans la liste. A la sortie de la macro (qui prend un peu de temps), active la feuille "Archives" du classeur Destination et dis-nous si ce qui y apparaît est conforme à ce qui devrait s'y trouver ...
 

Pièces jointes

  • Destination.xlsm
    600.5 KB · Affichages: 62
  • Destination.xlsm
    600.5 KB · Affichages: 67
  • Destination.xlsm
    600.5 KB · Affichages: 44

piga25

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

Bonjour le forum, Luc

Un grand merci Luc, cela commence à devenir très bon.

VB:
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
    Application.ScreenUpdating = False
    Set ZZ = TBa.Cells(l, 1)
    'copie n°dossier
    ZZ.Value = ff.[D1].Value
    'copie nom rencontre
    ZZ.Offset(0, 1) = ff.Range("V1")
    'copie la date de la rencontre
    ZZ.Offset(0, 2) = ff.Range("V3")
    'copie le nom de l'arbitre

    'je n'ai pas mis la suite du code
J'ai compris pour la variable ff
Comme tu me l'avais proposé, j'ai bien essayé comme tu l'a fait. J'avais bien mis cette variable devant chaque [D1] mais j'ai complétement zappé devant chaque .Range("xx"). Je suis allé trop vite et j'ai mal lu ton post #16 où tu me disais bien de la mettre aussi devant chaque Range("xx"). Cela doit être la raison pour laquelle je n'y suis pas arrivé malgré tous tes conseils. Je m'en veux.

Actuellement, avec le code comme il est, j'arrive bien a copier plusieurs feuilles sans le moindre problème. Toutes les données sont au bon endroit dans la feuille "Formulaire" et la feuille "Archives".
Ouf une partie de résolue.

Reste à voir avec la seconde partie du code Archiver car là aussi je pense que cette fameuse cellule [D1] à aussi son importance.
 

Modeste

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

Salut

Un grand merci Luc, cela commence à devenir très bon
... Oserais-je un "Alléluia !!"

J'ai compris pour la variable ff
Vous m'en voyez positivement ravi, très cher

Reste à voir avec la seconde partie du code Archiver car là aussi je pense que cette fameuse cellule [D1] à aussi son importance.
Je confirme ... sauf que ... on est d'accord sur le fait que ce n'est pas tellement [D1] qui est importante, mais ce qui figurera juste devant!?

Comme je ne me suis pas encore intéressé au reste du code, qu'il est relativement court et que le principe est le même, je te laisse le soin d'adapter!?
 

piga25

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

Re

J'ai bien compris que ce n'est pas [D1] mais bien ce qui est devant.


Je vais essayer et te dirai.
 

piga25

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

Re

Je pense que c'est comme cela qu'il faut rédiger le code :

VB:
' Inscriptions des données dans la feuille RECAP
    With ThisWorkbook.Sheets("Recap")
      .Unprotect
      .[D1] = ff.[D1]
      tbr.Range("A" & tbr.[D2]) = [D1]
      Set ZZ = tbr.Columns(1).Find([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
      For k = 0 To 10
        ZZ.Offset(k, 1) = ff.Range("V3") 'Inscription de la date de la rencontre
        ZZ.Offset(k, 2) = ff.Range("V1") 'Inscription lieu de rencontre
        ZZ.Offset(k, 3) = ff.Range("B" & 10 + k) 'Inscription n° dans match
        ZZ.Offset(k, 4) = ff.Range("J1") 'Inscription du pays
        ZZ.Offset(k, 5) = ff.Range("C" & 10 + k) 'Inscription du titulaire ou remplaçant
        ZZ.Offset(k, 6) = ff.Range("E" & 10 + k) 'Inscription des noms des participants
        ZZ.Offset(k, 7) = ff.Range("W" & 10 + k) 'Inscription de la durée du match
        ZZ.Offset(k, 8) = ff.Range("S" & 10 + k) 'Inscription des touches données
        ZZ.Offset(k, 9) = ff.Range("AB" & 10 + k) 'Inscription des touches reçues
        ZZ.Offset(k, 10) = ff.Range("AV" & 10 + k) 'Inscription de l'indice
        ZZ.Offset(k, 11) = ff.Range("AX" & 10 + k) 'Match gagné, perdu ou nul
        ZZ.Offset(k, 12) = ff.Range("AS" & 10 + k) 'Inscription du titulaire ou remplaçant pays adversaire
        ZZ.Offset(k, 13) = ff.Range("AJ" & 10 + k) 'Inscription des noms des participants
        ZZ.Offset(k, 14) = ff.Range("AH1") 'Inscription du pays adversaire
        ZZ.Offset(k, 15) = ff.Range("T2") 'Inscription Direct ou Classement
      Next
      .Protect
    End With
 

Modeste

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

Re (aussi)

Vu d'ici, il y a juste deux occurences de [D1] qui me laissent songeur, en fin de ligne 4 et dans le .Find en ligne 5 ... pour le reste ... tu as déjà testé?
 

piga25

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

RE,

Vu d'ici, il y a juste deux occurences de [D1] qui me laissent songeur, en fin de ligne 4 ....
Pour le [D1] en fin de ligne 4, il le faut bien car à la ligne numérotée en D2 , la première cellule (en colonne A) du tableau de la rencontre prend bien ce numéro là.

..... et dans le .Find en ligne 5 ...
Ce n'est pas moi qui est trouvé ce code, mais de ce que j'ai compris, la variable zz va commencer le début de la boucle à cette ligne là, d'où le D1 en fin de ligne 4 (réponse ci-dessus).

... pour le reste ... tu as déjà testé?
J'ai testé et cela fonctionne. Je ne sais pas si il est possible d'accélérer ce code. Déjà c'est bien pour moi.
Merci

Je vais juste rajouter une ou deux lignes pour fermer le fichier "Source" sans le sauvegarder de manière à n'y apporter aucune modif, et afficher la feuille "Formulaire" du classeur "Destination" comme page active.
 
Dernière édition:

Modeste

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

Bonsoir,

Quand je disais que les 2 références me laissaient songeur, la question n'était pas de savoir à quoi elles servaient, mais si elles ne devaient pas être précédées d'un petit "ff.", comme les autres

Quant à accélérer le code, c'est sans doute possible en utilisant une autre technique que le copier-coller d'une ou deux cellules à la fois. Ceci dit, termine d'abord le code tel que commencé, assure-toi qu'il fonctionne sans erreur ... ensuite on verra ce qu'on peut tenter d'améliorer
 

klin89

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

Bonjour à tous,

Une petite incursion :
Pourquoi ne pas définir vos 2 classeurs explicitement ?
Code:
Set wb1 = ThisWorkbook 'classeur destination
Set wb2 = ActiveWorkbook 'classeur source
ActiveWorkbook peut-être ThisWorkbook, non !

Klin89
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…