Une boucle qui transferts les donner une seule fois

Fermé
BelhoucineDine Messages postés 41 Date d'inscription jeudi 15 décembre 2016 Statut Membre Dernière intervention 10 mai 2023 - 6 mai 2017 à 15:35
BelhoucineDine Messages postés 41 Date d'inscription jeudi 15 décembre 2016 Statut Membre Dernière intervention 10 mai 2023 - 10 mai 2017 à 16:17
Bonjour, j'ai créée un programme dans Excel 2007 pour transferts les donner de la feuille 1 à la feuille 2 et 3 suivent une condition.
J'ai fais un bouton avec VBA qui transferts les donner, mai chaque fois quand je click sur CommandButton1 ce répète plusieurs fois
Je veux une boucle qui transferts les donner une seule fois
Voilà mon code:
Private Sub CommandButton1_Click()
Dim cl As Range, i As Integer
For i = 2 To 3
For Each cl In Range("H4:H" & [H10000].End(xlUp).Row)
If cl.Value = Sheets(i).Name Then
cl.Offset(0, -6).Resize(1, 7).Copy Sheets(i).Range("B" & Sheets(i).[B10000].End(xlUp).Row + 1)
End If
Next cl
Next i
MsgBox "Transfert apte et inapte", vbOKOnly, "Transfert"

'MsgBox "Vous ne pouvez pas transfert à nouveau", vbOKOnly, "Transfert"
End Sub

2 réponses

phadeb Messages postés 86 Date d'inscription dimanche 2 avril 2006 Statut Membre Dernière intervention 13 mai 2017 21
7 mai 2017 à 15:37
Bonjour,

Déja je te conseille d'inverser tes boucles, parcequ'il parcours 2 fois ta feuille 1 alors qu'une fois est suffisante

Dim cl As Range, i As Integer
For Each cl In Range("H4:H" & [H10000].End(xlUp).Row)
For i = 2 To 3
If cl.Value = Sheets(i).Name Then
cl.Offset(0, -6).Resize(1, 7).Copy Sheets(i).Range("B" & Sheets(i).[B10000].End(xlUp).Row + 1)
End If
Next i
Next cl
MsgBox "Transfert apte et inapte", vbOKOnly, "Transfert"
'MsgBox "Vous ne pouvez pas transfert à nouveau", vbOKOnly, "Transfert"


Ensuite si j'ai bien compris, tu ne veux pas avoir de doublons. Le plus simple est d'appliquer à la fin, en dehors des boucles, cette fonction pour enlever les doublons :

ActiveSheet.Range("$B$2:$H$17").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7 _
        ), Header:=xlNo


D'autres conseils :

-utilise plutôt end(xldown) plutôt que end(xlup)
-utilise un assignement de cellules direct plutôt que la fonction Copy
--
0
BelhoucineDine Messages postés 41 Date d'inscription jeudi 15 décembre 2016 Statut Membre Dernière intervention 10 mai 2023
7 mai 2017 à 22:14
Merci Phadeb pour votre réponse
Tout ce que vous avez demandé que j'ai essayé mais n'a pas réussi
Ma commande est:
Lorsque vous appuyez sur le bouton pour la première fois le relais, et lorsque vous appuyez sur le bouton pour la deuxième fois ce répète deux fois et plus le transfert de donner
J'utilise la fonction Copy plus pratique parce que je la métrise
Pour les doublons n’est pas un problème parce que les tableaux les demandent
0
f894009 Messages postés 17205 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 19 octobre 2024 1 709
8 mai 2017 à 10:05
Bonjour a vous deux

BelhoucineDine:
Je veux une boucle qui transferts les donner une seule fois
et
Pour les doublons n’est pas un problème parce que les tableaux les demandent


Y a un probleme, vous ne voulez pas de doublons mais y en a donc tout va bien.
0
phadeb Messages postés 86 Date d'inscription dimanche 2 avril 2006 Statut Membre Dernière intervention 13 mai 2017 21 > f894009 Messages postés 17205 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 19 octobre 2024
8 mai 2017 à 10:52
Je pense qu'il ne veux pas plus de doublons que les doublons initialement présents
0
BelhoucineDine Messages postés 41 Date d'inscription jeudi 15 décembre 2016 Statut Membre Dernière intervention 10 mai 2023 > phadeb Messages postés 86 Date d'inscription dimanche 2 avril 2006 Statut Membre Dernière intervention 13 mai 2017
8 mai 2017 à 17:23
Merci, a tous
Comment puis-je vous envoyer le classeur ? ça aurait plus clair
En cliquant sur le bouton pour la première fois l'exécution du Macro sera une seule foit
0
f894009 Messages postés 17205 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 19 octobre 2024 1 709 > BelhoucineDine Messages postés 41 Date d'inscription jeudi 15 décembre 2016 Statut Membre Dernière intervention 10 mai 2023
9 mai 2017 à 06:30
Bonjour,

Pour transmettre un fichier,
Veillez a ce qu'il n'y ait PAS DE DONNEES CONFIDENTIELLES
il faut passer par un site de pièce jointe tel que cjoint.com

Allez sur ce site : https://www.cjoint.com/
Clic sur parcourir,
Cherche ton fichier,
clic sur ouvrir,
Clic sur "Créer le lien cjoint",
Copier le lien,
Revenir ici le coller dans une réponse...
0
BelhoucineDine Messages postés 41 Date d'inscription jeudi 15 décembre 2016 Statut Membre Dernière intervention 10 mai 2023 > f894009 Messages postés 17205 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 19 octobre 2024
9 mai 2017 à 17:22
0