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

Pb de compteur

  • Initiateur de la discussion Patricia
  • Date de début
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
P

Popeye

Guest
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
F

FDI

Guest
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
F

FDI

Guest
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
P

Patricia

Guest
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

  • Test.zip
    17.6 KB · Affichages: 24
  • Test.zip
    17.6 KB · Affichages: 24
  • Test.zip
    17.6 KB · Affichages: 30
Vote positif 0 Vote négatif
F

FDI

Guest
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.

Discussions similaires

  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
353
Chaton77
J
  • Question
Microsoft 365 Code VBA
Réponses
10
Affichages
704
jebibo
J
P
  • Question
XL 2016 Compteur avec incrémentation de la ligne suivante
Réponses
11
Affichages
222
Pascal THIDET
P
L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
254
Latias
L
G
  • Résolu(e)
XL 2010 Obliger la validation d'un bouton d'option.
Réponses
8
Affichages
290
gillesda
G
L
  • Question
Microsoft 365 Faire agir une macro en fonction de l'emplacement du bouton
Réponses
2
Affichages
296
AtTheOne
  • Résolu(e)
XL 2021 Revenir sur Excel
Réponses
6
Affichages
364
Franc58
F
J
  • Question
Microsoft 365 Erreur de compilation: sub, fonction ou property attendue
Réponses
4
Affichages
427
dysorthographie
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
489
Compte Supprimé 979
C
M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
517
M@xu3L
M
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…