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

Pb de compteur

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion Patricia
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
P

Patricia

Guest
Bonjour,

J'ai une macro avec des conditions et notamment une boucle mais au bout de 21 fois la boucle arrête alors qu'il y a encore des données à prendre.

je pense qu'il faut mettre un compteur mais je ne sais pas à quel niveau - j'ai fais des essais mais ca me fonctionne pas ...

quelqu'un peut-il m'aider !!! je vous joins la macro

Merci d'avance

Patricia



Sub Tri_Travel() 'attention il y a un problème de compteur à voir

Dim DernLigne As Long
Dim LigneCible As Long
Dim LigneTotal As Long
Dim Counter As Long

'enlève les anciennes données de la feuille
Sheets("Travel").Select
Range("A2:G59999").Select
Selection.ClearContents
Range("A2").Select

Sheets("BD WP3").Select
Selection.AutoFilter Field:=2, Criteria1:="WP3*"
Range("A:A,C:C,D😀,E:E,J:J,K:K,O:O").Select
Selection.Copy
Sheets("Travel").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Columns("A:G").Select
Range("G1").Activate
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("a2").Select

Windows("Bd WP3.xls").Activate
Sheets("Form2").Select
Range("A22").Select
Sheets("Form2").Copy Before:=Sheets(4)
Sheets("Form2 (2)").Select
Sheets("Form2 (2)").Name = "2"

DernLigne = Sheets("Form2").Range("a65536").End(xlUp).Row ' numéro dernière ligne de la feuille 1 de BDactivite1
LigneCible = 22

For Each cell In Range("h2:h" & DernLigne)
If cell.Value = Range("j1").Value Then
Workbooks("Bd WP3.xls").Sheets("2").Range("A" & LigneCible).Value = (Workbooks("BD WP3.xls").Sheets("Travel").Range("B" & cell.Row).Value)
Workbooks("Bd WP3.xls").Sheets("2").Range("B" & LigneCible).Value = (Workbooks("BD WP3.xls").Sheets("Travel").Range("C" & cell.Row).Value)
Workbooks("Bd WP3.xls").Sheets("2").Range("C" & LigneCible).Value = (Workbooks("BD WP3.xls").Sheets("Travel").Range("D" & cell.Row).Value)
Workbooks("Bd WP3.xls").Sheets("2").Range("D" & LigneCible).Value = (Workbooks("BD WP3.xls").Sheets("Travel").Range("A" & cell.Row).Value)
Workbooks("Bd WP3.xls").Sheets("2").Range("E" & LigneCible).Value = (Workbooks("BD WP3.xls").Sheets("Travel").Range("E" & cell.Row).Value)
Workbooks("Bd WP3.xls").Sheets("2").Range("F" & LigneCible).Value = (Workbooks("BD WP3.xls").Sheets("Travel").Range("F" & cell.Row).Value)
Workbooks("Bd WP3.xls").Sheets("2").Range("G" & LigneCible).Value = (Workbooks("BD WP3.xls").Sheets("Travel").Range("G" & cell.Row).Value)

LigneCible = LigneCible + 1
If LigneCible >= 26 Then
Workbooks("Bd WP3.xls").Sheets("2").Rows(LigneCible).Insert

Counter = 100
End If
End If
Next
LigneTotal = Workbooks("Bd WP3.xls").Sheets("Pers1A").Range("b65536").End(xlUp).Row
FormuleTotal = "=sum(e22:e" & LigneTotal - 1 & ")"
Workbooks("Bd WP3.xls").Sheets("2").Range("e" & LigneTotal).Value = FormuleTotal

Sheets("2").Select
Sheets("2").Move After:=Workbooks("WP3.xls").Sheets(1)
ActiveWorkbook.Save
Windows("Bd WP3.xls").Activate
Sheets("BD WP3").Select
Selection.AutoFilter Field:=2
ActiveWorkbook.Save


End Sub
 
Trier par date Trier par votes
bonjour

peux tu mettre ton fichier excel en piece attachée (zip le stp)
supprime les données confidentielles ;o)

parce que j'ai du mal a voir ce dont tu parles

merci d'avance
 
Vote positif 0 Vote négatif
Bonjour

je pense avoir compris pourquoi votre boucle s'arrête.

Vous selctionnez la plage de cellule de la colonne H depuis la ligne 2 jusquà la dernière ligne, puis votre boucle balaie toutes les cellules de cette selection.

Or, dans votre boucle, vous précisez aue au dela de la lignecible = 26 les données sont collées APRES avoir inséré une nouvelle ligne.

Donc, ce qui se passe, c'est que lorsque vous insérez votre ligne, vous décalez les lignes de données à prendre vers le bas ALORS QUE VOTRE PLAGE DE CELLULES à balayer ne bouge pas.

En fait, votre insertion de ligne a pour effet de sortir de la plage scannée les données comprises entre la ligne 26 et le dernligne.

Je cherche une solution de mon coté, et si je trouve, je vous reviens.
 
Vote positif 0 Vote négatif
Re bonjour,

je ne suis pas sur d'avoir compris, mais pouvez vous essayer cette macro "revue", en faisant surtout attention d'utiliser des fichiers de tests ...

Sub Tri_Travel() 'attention il y a un problème de compteur à voir

Dim DernLigne As Long
Dim LigneCible As Long
Dim LigneTotal As Long
Dim Counter As Long

'enlève les anciennes données de la feuille
Sheets("Travel").Select
Range("A2:G59999").Select
Selection.ClearContents
Range("A2").Select

Sheets("BD WP3").Select
Selection.AutoFilter Field:=2, Criteria1:="WP3*"
Range("A:A,C:C,D😀,E:E,J:J,K:K,O:O").Select
Selection.Copy
Sheets("Travel").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Columns("A:G").Select
Range("G1").Activate
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("a2").Select

Windows("Bd WP3.xls").Activate
Sheets("Form2").Select
Range("A22").Select
Sheets("Form2").Copy Before:=Sheets(4)
Sheets("Form2 (2)").Select
Sheets("Form2 (2)").Name = "2"

DernLigne = Sheets("Form2").Range("a65536").End(xlUp).Row ' numéro dernière ligne de la feuille 1 de BDactivite1
LigneCible = 22

ligne_encours = 2

While CStr(Cells(ligne_encours, 8).Value) <> ""
mavaleur = Cells(ligne_encours, 8).Value
'For Each cell In Range("h2:h" & DernLigne)
'If cell.Value = Range("j1").Value Then
If mavaleur = Range("j1").Value Then
Workbooks("Bd WP3.xls").Sheets("2").Range("A" & LigneCible).Value = (Workbooks("BD WP3.xls").Sheets("Travel").Range("B" & ligne_encours).Value)
Workbooks("Bd WP3.xls").Sheets("2").Range("B" & LigneCible).Value = (Workbooks("BD WP3.xls").Sheets("Travel").Range("C" & ligne_encours).Value)
Workbooks("Bd WP3.xls").Sheets("2").Range("C" & LigneCible).Value = (Workbooks("BD WP3.xls").Sheets("Travel").Range("D" & ligne_encours).Value)
Workbooks("Bd WP3.xls").Sheets("2").Range("D" & LigneCible).Value = (Workbooks("BD WP3.xls").Sheets("Travel").Range("A" & ligne_encours).Value)
Workbooks("Bd WP3.xls").Sheets("2").Range("E" & LigneCible).Value = (Workbooks("BD WP3.xls").Sheets("Travel").Range("E" & ligne_encours).Value)
Workbooks("Bd WP3.xls").Sheets("2").Range("F" & LigneCible).Value = (Workbooks("BD WP3.xls").Sheets("Travel").Range("F" & ligne_encours).Value)
Workbooks("Bd WP3.xls").Sheets("2").Range("G" & LigneCible).Value = (Workbooks("BD WP3.xls").Sheets("Travel").Range("G" & ligne_encours).Value)

LigneCible = LigneCible + 1
If LigneCible >= 26 Then
Workbooks("Bd WP3.xls").Sheets("2").Rows(LigneCible).Insert
DernLigne = DernLigne + 1

Counter = 100
End If
End If
ligne_encours = ligne_encours + 1
Wend

LigneTotal = Workbooks("Bd WP3.xls").Sheets("Pers1A").Range("b65536").End(xlUp).Row
FormuleTotal = "=sum(e22:e" & LigneTotal - 1 & ")"
Workbooks("Bd WP3.xls").Sheets("2").Range("e" & LigneTotal).Value = FormuleTotal

Sheets("2").Select
Sheets("2").Move After:=Workbooks("WP3.xls").Sheets(1)
ActiveWorkbook.Save
Windows("Bd WP3.xls").Activate
Sheets("BD WP3").Select
Selection.AutoFilter Field:=2
ActiveWorkbook.Save


End Sub
 
Vote positif 0 Vote négatif
Popeye

Voilà le fichier un peu allégé et simplifié....

Je te remercie d'avance car je n'ai jamais utilisé de compteur, je ne sias pas où le mettre pour qu'il fonctionne.

Je te souhaite une bonne soirée

Patricia
 

Pièces jointes

Vote positif 0 Vote négatif
Bonjour,

si je peux me permettre de proposer une réponse, cette sub ci dessous fonctionne chez moi.

Un petit mot pour dire si ok ou ko ?

Bonne journée.

Sub Tri_Travel() 'attention il y a un problème de compteur à voir

Dim DernLigne As Long

Dim LigneCible As Long
Dim LigneTotal As Long
Dim Counter As Long


Windows("Test.xls").Activate
Sheets("Form2").Select
Range("A22").Select
Sheets("Form2").Copy Before:=Sheets(2)
Sheets("Form2 (2)").Select
Sheets("Form2 (2)").Name = "Recap"

DernLigne = Sheets("Travel").Range("a65536").End(xlUp).Row ' numéro dernière ligne de la feuille 1 de BDactivite1
LigneCible = 22

For Each cell In Workbooks("Test.xls").Sheets("Travel").Range("h2:h" & DernLigne)
If cell.Value = Workbooks("Test.xls").Sheets("Travel").Range("j1").Value Then
Workbooks("Test.xls").Sheets("Recap").Range("A" & LigneCible).Value = (Workbooks("Test.xls").Sheets("Travel").Range("B" & cell.Row).Value)
Workbooks("Test.xls").Sheets("Recap").Range("B" & LigneCible).Value = (Workbooks("Test.xls").Sheets("Travel").Range("C" & cell.Row).Value)
Workbooks("Test.xls").Sheets("Recap").Range("C" & LigneCible).Value = (Workbooks("Test.xls").Sheets("Travel").Range("D" & cell.Row).Value)
Workbooks("Test.xls").Sheets("Recap").Range("D" & LigneCible).Value = (Workbooks("Test.xls").Sheets("Travel").Range("A" & cell.Row).Value)
Workbooks("Test.xls").Sheets("Recap").Range("E" & LigneCible).Value = (Workbooks("Test.xls").Sheets("Travel").Range("E" & cell.Row).Value)
Workbooks("Test.xls").Sheets("Recap").Range("F" & LigneCible).Value = (Workbooks("Test.xls").Sheets("Travel").Range("F" & cell.Row).Value)
Workbooks("Test.xls").Sheets("Recap").Range("G" & LigneCible).Value = (Workbooks("Test.xls").Sheets("Travel").Range("G" & cell.Row).Value)

LigneCible = LigneCible + 1
If LigneCible >= 26 Then
Workbooks("Test.xls").Sheets("Recap").Rows(LigneCible).Insert

Counter = 100
End If
End If

Next
LigneTotal = Workbooks("Test.xls").Sheets("Recap").Range("b65536").End(xlUp).Row
FormuleTotal = "=sum(e22:e" & LigneTotal - 1 & ")"
Workbooks("Test.xls").Sheets("Recap").Range("e" & LigneTotal).Value = FormuleTotal


End Sub
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
453
Chaton77
G
  • Question Question
XL 2019 Sélectionner un fichier pour mettre à jour une base de données
Réponses
3
Affichages
197
sylvanu
J
  • Question Question
Microsoft 365 Code VBA
Réponses
10
Affichages
773
jebibo
J
D
  • Résolu(e)
XL 2019 Nouveau Numéro
2 3 4
Réponses
57
Affichages
2 K
patricktoulon
  • Question Question
Autres fenêtre "Publication"
Réponses
10
Affichages
455
ph.vanne
F
  • Question Question
Microsoft 365 aide VBA excel
Réponses
4
Affichages
332
Oneida
P
  • Question Question
XL 2016 Compteur avec incrémentation de la ligne suivante
Réponses
11
Affichages
254
Pascal THIDET
P
L
  • Question Question
VBA : erreur sur boucle
Réponses
2
Affichages
289
Latias
L
G
  • Résolu(e)
XL 2010 Obliger la validation d'un bouton d'option.
Réponses
8
Affichages
353
gillesda
G
L
  • Question Question
Microsoft 365 Faire agir une macro en fonction de l'emplacement du bouton
Réponses
2
Affichages
360
AtTheOne
  • Résolu(e)
XL 2021 Revenir sur Excel
Réponses
6
Affichages
412
Franc58
F
J
  • Question Question
Microsoft 365 Erreur de compilation: sub, fonction ou property attendue
Réponses
4
Affichages
501
dysorthographie
B
  • Question Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
571
Compte Supprimé 979
C
M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
576
M@xu3L
M
R
  • Question Question
XL 2021 Optimisation Code VBA
Réponses
10
Affichages
639
Dranreb
D
  • Question Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
2 K
Dranreb
T
  • Question Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
2 K
thivame
T
G
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
481
GClaire
G
  • Question Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
569
AtTheOne
B
  • Résolu(e)
Microsoft 365 creation d'liste à imprimer
2 3 4
Réponses
51
Affichages
1 K
Banbara
B
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…