Assemblage de macro et execution sur une feuille unique

Bonjour tout le monde,

Je cherche à assembler plusieurs macro en une seule macro VBA pour les executer d'une et même seule feuille. En effet, actuellement, elles fonctionnent toutes chacune sur une feuille différente en appuyant sur un bouton. J'aimerai tout centraliser sur un bouton pour toutes les exécuter sur leurs feuilles respectives.

En vous remerciant par avance.

Je vous joins les différentes Macro.

1er macro

Sub Tour_ouverte()

Application.ScreenUpdating = False

For i = 2 To 13
    If Cells(64, i) - 1 <= Cells(4, i) Then
    Cells(66, i).Interior.ColorIndex = 3
    Cells(64, i).Select
    Selection.Copy
    Cells(67, i).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Else
    Cells(67, i) = Cells(64, i)
    Cells(66, i).Interior.ColorIndex = 2
    End If

    If Cells(64, i) - 1 <= Cells(4, i) Then
    Cells(81, i) = 1
    Cells(64, i) = Cells(4, i) + 2
    Cells(79, i).GoalSeek goal:=0, changingcell:=Cells(29, i)
    Cells(77, i).GoalSeek goal:=0, changingcell:=Cells(60, i)
    Cells(75, i).GoalSeek goal:=0, changingcell:=Cells(12, i)
    Else
    Cells(81, i) = 1
    Cells(79, i).GoalSeek goal:=0, changingcell:=Cells(29, i)
    Cells(77, i).GoalSeek goal:=0, changingcell:=Cells(60, i)
    Cells(75, i).GoalSeek goal:=0, changingcell:=Cells(12, i)
    End If

Next i

For i = 2 To 13

    Do
    Cells(81, i) = Cells(81, i) - 0.0001
    Loop Until Cells(87, i) <= 0
Cells(75, i).GoalSeek goal:=0, changingcell:=Cells(12, i)
Next i

Application.ScreenUpdating = True
End Sub

2ème Macro sur une autre feuille

Sub resolution_drycooler()
Application.ScreenUpdating = False

For i = 2 To 13
    Cells(74, i).Interior.ColorIndex = 2 
    If Cells(60, i) >= Cells(76, i) Then 
    Cells(74, i) = 1
    Else
    Cells(57, i) = Cells(60, i) + 7 
    Cells(84, i).GoalSeek goal:=0, changingcell:=Cells(74, i)
    Cells(89, i).GoalSeek goal:=0, changingcell:=Cells(74, i)
    End If
    If Cells(74, i) > 1 Then
    Cells(74, i) = 0.9
    End If
    If Cells(60, i) >= Cells(59, i) Then
    Cells(57, i) = Cells(60, i) + 5
    End If
Next
For i = 2 To 13

    If Cells(77, i) < 0 Then
        Do
        Cells(84, i).GoalSeek goal:=0, changingcell:=Cells(57, i)
        Cells(74, i) = Cells(74, i) - 0.0005
        Loop Until Cells(77, i) >= 0.01
    Else
        Do
        Cells(84, i).GoalSeek goal:=0, changingcell:=Cells(57, i)
        Cells(74, i) = Cells(74, i) + 0.0005
        If Cells(74, i) > 1 Then Exit Do
        Loop Until Cells(77, i) <= 0.01
    End If
Next 

For i = 2 To 13
Cells(67, i).GoalSeek goal:=0, changingcell:=Cells(57, i)
    If Cells(74, i) > 1 Then
    Cells(74, i).Interior.ColorIndex = 3 
    Else
    Cells(74, i).Interior.ColorIndex = 2
    End If
Next 

For i = 2 To 13
    If Cells(84, i) > 3000 Then 
     Cells(57, i) = Cells(76, i)
     Cells(84, i).GoalSeek goal:=0, changingcell:=Cells(74, i)
     Cells(89, i).GoalSeek goal:=0, changingcell:=Cells(74, i)
     Cells(67, i).GoalSeek goal:=0, changingcell:=Cells(57, i)
     End If
Next 

Application.ScreenUpdating = True

End Sub

3ème macro

Sub colebrook_0()

For i = 5 To 16

Cells(13, i).GoalSeek goal:=0, changingcell:=Cells(12, i)
Next i

End Sub

4ème et dernière macro

DefBool Y 

Sub recherche_EER()

For i = 3 To 14
b = Cells(9, i).Value
c = Cells(5, i).Value
Y1 = b >= 10 And b < 12.5
Y2 = b >= 12.5 And b < 15
Y3 = b >= 15 And b < 17.5
Y4 = b >= 17.5 And b < 20
Y5 = b >= 20 And b < 22.5
Y6 = b >= 22.5 And b < 25
Y7 = b >= 25 And b < 27.5
Y8 = b >= 27.5 And b < 30
Y9 = b >= 30 And b < 32.5
Y10 = b >= 32.5 And b < 35
Y11 = b >= 35 And b < 37.5
Y12 = b >= 37.5 And b < 40
Y13 = b >= 40 And b < 60

    If Y1 Then
        Cells(6, i) = -19.579 * c ^ 3 + 30.073 * c ^ 2 - 11.613 * c + 9.8294
    ElseIf Y2 Then
        Cells(6, i) = -9.9568 * c ^ 2 + 11.362 * c + 7.0693
    ElseIf Y3 Then
        Cells(6, i) = 26.895 * c ^ 3 - 57.613 * c ^ 2 + 34.33 * c + 4.6334
    ElseIf Y4 Then
        Cells(6, i) = 19.11 * c ^ 3 - 42.891 * c ^ 2 + 26.919 * c + 4.8065
    ElseIf Y5 Then
        Cells(6, i) = 15.46 * c ^ 3 - 34.518 * c ^ 2 + 22.057 * c + 4.7047
    ElseIf Y6 Then
        Cells(6, i) = 13.855 * c ^ 3 - 31.919 * c ^ 2 + 20.806 * c + 4.1679
    ElseIf Y7 Then
        Cells(6, i) = 12.25 * c ^ 3 - 29.32 * c ^ 2 + 19.555 * c + 3.6311
    ElseIf Y8 Then
        Cells(6, i) = 10.32 * c ^ 3 - 25.491 * c ^ 2 + 17.413 * c + 3.4137
    ElseIf Y9 Then
        Cells(6, i) = 8.3902 * c ^ 3 - 21.663 * c ^ 2 + 15.272 * c + 3.1962
    ElseIf Y10 Then
        Cells(6, i) = 7.3327 * c ^ 3 - 19.049 * c ^ 2 + 13.628 * c + 2.8743
    ElseIf Y11 Then
        Cells(6, i) = 6.2753 * c ^ 3 - 16.435 * c ^ 2 + 11.984 * c + 2.5524
    ElseIf Y12 Then
        Cells(6, i) = 5.6145 * c ^ 3 - 14.571 * c ^ 2 + 10.628 * c + 2.3383
    ElseIf Y13 Then
        Cells(6, i) = 4.9537 * c ^ 3 - 12.706 * c ^ 2 + 9.2711 * c + 2.1243
    Else
    Cells(6, i) = "Erreur"

    End If

Next

End Sub

bonjour,

une proposition (nom des feuilles à adapter)

Sub aargh()
    Sheets("feuil1").Activate
    tour_ouverte
    Sheets("feuil2").Activate
    resolution_drycooler
    Sheets("feuil3").Activate
    colebrook_0
    Sheets("feuil4").Activate
    recherche_EER
End Sub

Super, cela marche !

merci de ton aide

Bonne journée