Macro qui saute ou pas selon les resultats

djkrom2003

XLDnaute Nouveau
Bonjour a tous, je viens vous soliciter car J'ai creer une macro qui a pour but de trouver une différence de valeur en tatonnant.

Le problème est que la macro une fois à la fin Saute en plein milieu d'un autre macro..

et s'il ne trouve pas de différence tout va bien, elle se termine comme prévu.

Je vous joint la macro pour plus de compréhension :

Merci à vous
Code:
Sub demarrage_calcul_base_inverse()
Application.ScreenUpdating = False
'ActiveSheet.Range("$B$6:$AP$1745").AutoFilter Field:=30, Criteria1:="<>"
Range("ae1000").End(xlUp)(2).Select
Selection = "stop"
Range("ae6").Select

ActiveCell.Offset(1, 0).Select
    Do While ActiveCell = ""
    If ActiveCell = "stop" Then GoTo rien
    ActiveCell.Offset(1, 0).Select
Loop
Range("ah7").Select
Call calcul_base_inverse

rien:
Application.CutCopyMode = False
If ActiveCell <> "stop" Then Exit Sub
Range("ae1000").End(xlUp)(1).Select
Selection.ClearContents
'ActiveSheet.Range("$B$6:$AP$1745").AutoFilter Field:=30
MsgBox "Pas de recherche à effectuer"
Exit Sub
End Sub

Sub calcul_base_inverse()
Application.ScreenUpdating = False
Application.EnableEvents = False
Do While ActiveCell <> "0"
        If ActiveCell = "stop" Then GoTo fin_total
        ActiveCell.Offset(0, 3).Select
        If ActiveCell = "0" Then GoTo passe
        If ActiveCell = ActiveCell.Offset(0, -7).Value Then GoTo passe
        ActiveCell.Offset(0, -3).Select
        Call suite_calcul
        
passe:
If ActiveCell = "stop" Then Exit Sub
ActiveCell.Offset(0, -3).Select
ActiveCell.Offset(1, 0).Select
Loop
fin_total:
Application.CutCopyMode = False
Call fin_totale
End Sub

Sub suite_calcul()

Dim V_actuelle, Difference, Test_var, Position

Application.ScreenUpdating = False
Application.EnableEvents = False
ActiveSheet.Unprotect Password:="fosses95" 'déprotège l'onglet
Do While ActiveCell <> "0"
If ActiveCell = "stop" Then Call fin_totale
ActiveCell.Copy
ActiveCell.Offset(0, 2).PasteSpecial
ActiveCell.NumberFormat = "0"
ActiveCell.Value = ActiveCell.Value
ActiveCell.Copy
ActiveCell.Offset(0, -1).PasteSpecial
ActiveCell.Offset(0, 6).PasteSpecial
ActiveCell.Offset(0, -6).Select
Application.CutCopyMode = False
ActiveCell.Offset(0, -1).Select
Do While ActiveCell <> "0"
ActiveCell.Offset(0, 4).Select
ActiveCell.Copy
ActiveCell.Value = ActiveCell.Value
ActiveCell.Offset(0, -3).PasteSpecial
ActiveCell.Offset(0, 4).Select
ActiveCell.Copy
ActiveCell.Offset(0, -1).PasteSpecial
ActiveCell.Offset(0, -4).Select

        If ActiveCell = "0" Then Exit Do
        Loop
        Loop
        ActiveCell.Offset(0, 6).Copy
        ActiveCell.Offset(0, -1).PasteSpecial
        ActiveCell.NumberFormat = "0"
        ActiveCell.Value = ActiveCell.Value
        ActiveCell.Offset(0, 2).ClearContents
        ActiveCell.Offset(0, 1).Select
        ActiveCell.NumberFormat = "0"
        Call calcul_base_inverse
        
        
        

        
End Sub
Sub fin_totale()
ActiveCell.Offset(0, -1).ClearContents
Application.EnableEvents = False
Application.ScreenUpdating = False

Call nettoie
End Sub

Sub nettoie()
Application.EnableEvents = False
Application.ScreenUpdating = False
Range("ae7").Select
    Do While ActiveCell <> "stop"
    If ActiveCell = "stop" Then Exit Do
    Do While ActiveCell > "0"
    If ActiveCell = "stop" Then GoTo fin
    ActiveCell.Offset(1, 0).Select
    Loop
    ActiveCell.Offset(0, 2).ClearContents
    ActiveCell.Offset(1, 0).Select
    If ActiveCell = "stop" Then Exit Do
    Loop
    
fin:

Range("ae1000").End(xlUp)(1).Select
Selection.ClearContents
ActiveSheet.Protect Password:="fosses95" 'protège l'onglet
    MsgBox "la recherche est terminée"
    Range("ae7").Select
    GoTo fin_nettoyage
    
    ActiveSheet.Protect Password:="fosses95" 'protège l'onglet
    

    MsgBox "la recherche est terminée"
    Range("ah7").Select
Exit Sub
fin_nettoyage:
Exit Sub
End Sub
 

Discussions similaires

Réponses
21
Affichages
1 K

Statistiques des forums

Discussions
312 545
Messages
2 089 487
Membres
104 183
dernier inscrit
bast.coud