Boucle Loop qui ne se lance pas

[Snoopy6102000]

Bonjour,

J'ai créé une boucle dans ma macro, qui s'applique à un fichier que je viens d'ouvrir. Le soucis c'est que quand mon fichier s'ouvre, la Boucle ne se fait pas.

Le premier jet est fait et fonctionne bien que pour l'instant j'ai basé le nom du fichier par "nomdufichier1"...
Autre soucis lié à ça, je fais un second enregistrement en cas de modification, et donc dans mon fichier listing j'ai une cellelu à mettre à jour : le montant. je dois donc retrouner dans mon listing, retrouver la ligne (ça c'est pas dur, le numéro a été récupéré avant), et recopier.
Le soucis avec mon code, c'est qu'une fois que le fichier listing est ouvert, la macro n'enchaîne pas sur ma boucle :

Sub Réenregistrement()

' Réenregistrement avec nouveau montant
ActiveWorkbook.Save
'réouverture du fichier listing

Dim Année, Fichier, Chemin, AN, CheminComplet
Chemin = "\\HRY1129\Atelier\Clients\Remises de Prix\"
Année = Year(Sheets("Devis").Range("BD2")) & "\"


Fichier = "DEVIS_" & Sheets("Base").Range("P9").Value & ".xlsm"
AN = Sheets("Base").Range("P9").Value
CheminComplet = Chemin & Année
Devis = "Fiche devis " & Sheets("Base").Range("O11") & ".xlsm"
CopieMontant = Workbooks(Devis).Sheets(1).Range("U2")


Workbooks.Open CheminComplet & Fichier


B = 6
Set Cherche = Workbooks(Fichier).Sheets(1).Cells(B, 2)
Set CopieMontant = Workbooks(Devis).Sheets("Base").Range("H341")
Set Numero = Workbooks(Devis).Sheets("Devis").Range("U2")

Do While ArrêtChercher <> trouvé = Numero
With Sheets(1).Range("A6:s1206")
Set trouvé1 = .Find(Cherche)

If trouvé1 = Numéro Then
CopieMontant.Copy Workbooks(Fichier).Sheets(1).Cells(B, 10)
End If
End With

B = B + 1

Set Cherche = Sheets(1).Cells(B, 2)
Set CopieMontant = Workbooks(Devis).Sheets("Base").Range("H341")

Loop


'Fermer fichier linsting DEVIS


End Sub


Faut-il plutôt que j'appelle cette macro dans le fichier ouvert? Le pb est que cette boucle utilise les 2 fichiers ouvert. Elle trouve un numéro en U2 de mon premier fichier, et le chercher dans le fichier que je viens d'ouvrir, afin de mettre à jour le Montant.

Merci d'avance pour votre aide.

 

[Snoopy6102000]

Re : Boucle Loop qui ne se lance pas

Désolé je suis partie un peu vite, j'étais en réunion, là je fais mes dossiers pour l'atelier et je me remet dedans !

 

[Snoopy6102000]

Re : Boucle Loop qui ne se lance pas

Allez, c'est reparti, je me remet dedans, je vais donc aller dans mon module 9, Sub "réenregistrement", il me faut donc déclarer mes variables.

 

[Snoopy6102000]

Re : Boucle Loop qui ne se lance pas

Hello le forum,
Bon j'ai modifié comme suit :
J'ai mis en gras ce qui ne va pas.

Sub Réenregistrement()

' Réenregistrement avec nouveau montant
ActiveWorkbook.Save
'réouverture du fichier listing
Dim Chemin As String
Dim Année As String
Dim Fichier As String
Dim CheminComplet As String
Dim Devis As String
Dim CopieMontant As Variant
Dim Cherche As Range
Dim Numero As Range

Chemin = "\\HRY1129\Atelier\Clients\Remises de Prix\"
Année = Year(Sheets("Devis").Range("BD2")) & "\"
Fichier = "DEVIS_" & Sheets("Base").Range("P9").Value & ".xlsm"
CheminComplet = Chemin & Année
Devis = "Fiche devis " & Sheets("Base").Range("O11") & ".xlsm"

Workbooks.Open CheminComplet & Fichier
Windows(Fichier).Activate
Sheets(1).Select

B = 6
Set Cherche = Workbooks(Fichier).Sheets(1).Cells(B, 2)
Set CopieMontant = Workbooks(Devis).Sheets("Base").Range("H341")
Set Numero = Workbooks(Devis).Sheets("Devis").Range("U2")

Do While B < 500 'il faudrait que je trouve une meilleur condition de fin, car là c'est trop long, style "quand il a trouvé, c'est fini"
With Sheets(1).Range("A6:s1206")
Set trouvé1 = .Find(Cherche)

If trouvé1 = Numero Then
CopieMontant.Copy Workbooks(Fichier).Sheets(1).Cells(B, 10)
End If
End With

B = B + 1
Set Cherche = Sheets(1).Cells(B, 2)
Set CopieMontant = Workbooks(Devis).Sheets("Base").Range("H341")' j'ai besoin de la valeur
Loop
'Fermer fichier linsting DEVIS
End Sub

 

[Snoopy6102000]

Re : Boucle Loop qui ne se lance pas

pour la value, il faudrait que je mette,
Dim CopieMontant As ???
CopieMontant=Workbooks(Devis).Sheets("Base").Range("H341").Value

 

[Snoopy6102000]

Re : Boucle Loop qui ne se lance pas

Integer... j'suis nulle, j'l'ai déjà utilisé...

 

[Snoopy6102000]

Re : Boucle Loop qui ne se lance pas

Ce n'est pas forcément la bonne méthode (ya plus simple c'est sûr), mais ça marche, j'ai remplacer le fait de faire une seule ligne pour la copie, par une copie un peu classique avec des Select :
If trouvé1 = Numero Then
Windows(Devis).Activate
Sheets("Base").Select
Workbooks(Devis).Sheets("Base").Range("H341").Select
Selection.Copy
Windows(Fichier).Activate
Sheets(1).Select
Workbooks(Fichier).Sheets(1).Cells(B, 10).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

J'aurai voulu faire plus simple, mais en tout cas ça marche...

Si vous avez une idée pour réduire ça je suis preneuse.

Là je cherche pour ma condition

 

[Snoopy6102000]

Re : Boucle Loop qui ne se lance pas

En fait pour ma condition j'ai remplacé "While" par "Until" :

Do Until trouvé1 = Numero

Comme ça ça marche.
Merci pour les explications, si vous pouvez m'aider pour réduire le gros paquet du message du dessus, je veux bien !
Merci

 

[Snoopy6102000]

Re : Boucle Loop qui ne se lance pas

Pour le fun, j'ai rajouté ça : MsgBox ("Le montant du devis a été mis à jour.")

 

[Robert]

Re : Boucle Loop qui ne se lance pas

Bonjour Snoopy, bonjour le forum,

pour la value, il faudrait que je mette,
Dim CopieMontant As ???
CopieMontant=Workbooks(Devis).Sheets("Base").Range("H341").Value

Si le montant est (ou peut être) décimal utilise plutôt le type Double...

 

[Robert]

Re : Boucle Loop qui ne se lance pas

Bonjour le fil, bonjour le forum,

Évite les Select quand ils ne sont pas nécessaires. Ils ne font que ralentir l'exécution du code...

Windows(Devis).Activate
Sheets("Base").Select
Workbooks(Devis).Sheets("Base").Range("H341").Select
Selection.Copy
Windows(Fichier).Activate
Sheets(1).Select
Workbooks(Fichier).Sheets(1).Cells(B, 10).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Peut se simplifier :

Workbooks(Devis).Sheets("Base").Range("H341").Copy
Workbooks(Fichier).Sheets(1).Cells(B, 10).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

 

[Snoopy6102000]

Re : Boucle Loop qui ne se lance pas

Alors là Robert, j'suis bluffée !!!! Merciii !!!!