enchainé plusieurs code en une meme macro

3 réponses

Sunburn

30/01/2009 à 16:10

Bonjour,
j'ai plusieur macros que je voudrais executer par un seul et meme bouton.
en effet, je clique sur mon bouton, la macro 1 se fait, puis la macro, puis
la 3, et ainsi de suite.
comment structurer ma macro ??
MERCI beaucoup.
YANN
voici ma macro1:
-----
Sub CalculBalLive()
'supprime la colonne C
Sheets("GA14").Columns("C:C").Delete Shift:=xlToLeft
'calcul de la balance en temps réel
Sheets("GA10").Unprotect
Sheets("GA14").Unprotect
If Sheets("GA14").Range("A3") <> "" Then
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Clear
End If
Sheets("GA10").Range("A3", "F" &
Sheets("GA10").Range("A65535").End(xlUp).Row).Copy
Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0)
For Each I In Sheets(Array("GA11", "GA12", "GA13"))
If I.Range("C12") <> "" Then
Départ = Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0).Row
I.Range("C12", "F" & I.Range("C65535").End(xlUp).Row).Copy
Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0)
I.Range("H12", "H" & I.Range("H65535").End(xlUp).Row).Copy
Sheets("GA14").Range("B" & Départ)
End If
Next
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Interior.ColorIndex = xlNone
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Sort
Key1:=Sheets("GA14").Range("A3"), Order1:=xlAscending
J = 3
ligne = 2
Do While Range("A" & J).Row < Range("A65535").End(xlUp).Offset(1, 0).Row
If Range("A" & J) <> Range("A" & J - 1) And Range("A" & J) <> Range("A" &
ligne) Then
ligne = J
End If
If Range("A" & J) = Range("A" & ligne) And J > ligne Then
Range("C" & ligne) = Range("C" & ligne) + Range("C" & J)
Range("D" & ligne) = Range("D" & ligne) + Range("D" & J)
Range("B" & J).EntireRow.ClearContents
End If
If Range("A" & J) <> Range("A" & J + 1) Then
If Range("C" & ligne) < Range("D" & ligne) Then
Range("D" & ligne) = Range("D" & ligne) - Range("C" & ligne)
Range("C" & ligne) = ""
End If
If Range("C" & ligne) > Range("D" & ligne) Then
Range("C" & ligne) = Range("C" & ligne) - Range("D" & ligne)
Range("D" & ligne) = ""
End If
If Range("C" & ligne) = Range("D" & ligne) Then
Range("C" & ligne) = ""
Range("D" & ligne) = ""
End If
End If
J = J + 1
Loop
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Sort
Key1:=Sheets("GA14").Range("A3"), Order1:=xlAscending
Sheets("GA14").Range("A" &
Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0).Row,
"A65535").EntireRow.Delete
'insertion de la colonne C pour la présentation
Sheets("GA14").Columns("C:C").Insert Shift:=xlToRight
Sheets("GA14").Columns("C:C").ColumnWidth = 3
Sheets("GA10").Protect
'Sheets("GA14").Protect
'mettre tous les chiffres au bon format
Sheets("GA14").Columns("D:G").NumberFormat = "#,##0.00"
Sheets("GA14").Range("G1").NumberFormat = "dd/mm/yy;@"
'mettre un quadrillage à blanc sur GA14
Sheets("GA14").Cells.Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlDiagonalUp).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeLeft).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeTop).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeBottom).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeRight).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlInsideVertical).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
'verouiller l'onglet GA14
Sheets("GA14").Cells.Locked = True
Sheets("GA14").Cells.FormulaHidden = False
Sheets("GA14").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("GA14").EnableSelection = xlNoRestrictions
End Sub
------
ma macro 2 :
------
Sub Import10()
'supprimer les anciennes lignes
Application.Calculation = xlManual
Application.ScreenUpdating = False
Sheets("10").Activate
For I = Cells(Rows.Count, "a").End(1).Row To 2 Step -1
If Cells(I, 1) > 100000 And Cells(I, 1) < 99999999 Then Rows(I).Delete
Next
'ajoute les lignes
Sheets("10").Select
Range("DETAIL10").Select
On Error Resume Next
For Each C In Worksheets("GA14").Range("A2:A1000")
n1 = Mid(C, 1, 1)
n2 = Mid(C, 1, 4)
n4 = Mid(C, 1, 4)
n5 = Mid(C, 1, 4)
n10 = Mid(C, 1, 4)
n11 = Mid(C, 1, 4)
n12 = Mid(C, 1, 4)
n13 = Mid(C, 1, 3)
n14 = Mid(C, 1, 4)
If n1 = 1 Or n2 = 6611 Or n4 = 6874 Or n5 = 6875 _
Or n10 = 7865 Or n11 = 7874 Or n12 = 7875 Or n13 = 777 Or n14 = 7872 _
Then
Selection.EntireRow.Insert Shift:=xlDown
ActiveCell.Offset(0, 0).Select
Range(C, C.Offset(0, 255).End(xlToLeft)).Copy
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
End If
Next
Application.Calculation = xlAutomatic
End Sub
------
ma macro 3 : (après je ferrais tout seul)
-----
Sub Import20()
'supprimer les anciennes lignes
Application.Calculation = xlManual
Application.ScreenUpdating = False
Sheets("20").Activate
For I = Cells(Rows.Count, "a").End(1).Row To 2 Step -1
If Cells(I, 1) > 100000 And Cells(I, 1) < 99999999 Then Rows(I).Delete
Next
'ajoute les lignes
Sheets("20").Select
Range("DETAIL20").Select
On Error Resume Next
For Each C In Worksheets("GA14").Range("A2:A1000")
n1 = Mid(C, 1, 1)
n2 = Mid(C, 1, 3)
n3 = Mid(C, 1, 3)
n4 = Mid(C, 1, 4)
n5 = Mid(C, 1, 4)
n6 = Mid(C, 1, 4)
n7 = Mid(C, 1, 4)
n11 = Mid(C, 1, 3)
n12 = Mid(C, 1, 4)
n13 = Mid(C, 1, 4)
n14 = Mid(C, 1, 4)
If n1 = 2 Or n2 = 664 Or n3 = 675 Or n4 = 6811 Or n5 = 6816 Or n6 = 6871 Or
n7 = 6872 _
Or n11 = 775 Or n12 = 7811 Or n13 = 7816 Or n14 = 4962 _
Then
Selection.EntireRow.Insert Shift:=xlDown
ActiveCell.Offset(0, 0).Select
Range(C, C.Offset(0, 255).End(xlToLeft)).Copy
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
End If
Next
Application.Calculation = xlAutomatic
End Sub
-----

3 réponses

isabelle

30/01/2009 à 16:18

bonjour,

Private Sub CommandButton1_Click()
Macro1
Macro2
Macro3
End Sub

Sub Macro1()
MsgBox "Hello1"
End Sub

Sub Macro2()
MsgBox "Hello2"
End Sub

Sub Macro3()
MsgBox "Hello3"
End Sub

isabelle

Sunburn a écrit :

Bonjour,
j'ai plusieur macros que je voudrais executer par un seul et meme bouton.
en effet, je clique sur mon bouton, la macro 1 se fait, puis la macro, puis
la 3, et ainsi de suite.
comment structurer ma macro ??
MERCI beaucoup.
YANN
voici ma macro1:
-----
Sub CalculBalLive()
'supprime la colonne C
Sheets("GA14").Columns("C:C").Delete Shift:=xlToLeft
'calcul de la balance en temps réel
Sheets("GA10").Unprotect
Sheets("GA14").Unprotect
If Sheets("GA14").Range("A3") <> "" Then
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Clear
End If
Sheets("GA10").Range("A3", "F" &
Sheets("GA10").Range("A65535").End(xlUp).Row).Copy
Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0)
For Each I In Sheets(Array("GA11", "GA12", "GA13"))
If I.Range("C12") <> "" Then
Départ = Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0).Row
I.Range("C12", "F" & I.Range("C65535").End(xlUp).Row).Copy
Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0)
I.Range("H12", "H" & I.Range("H65535").End(xlUp).Row).Copy
Sheets("GA14").Range("B" & Départ)
End If
Next
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Interior.ColorIndex = xlNone
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Sort
Key1:=Sheets("GA14").Range("A3"), Order1:=xlAscending
J = 3
ligne = 2
Do While Range("A" & J).Row < Range("A65535").End(xlUp).Offset(1, 0).Row
If Range("A" & J) <> Range("A" & J - 1) And Range("A" & J) <> Range("A" &
ligne) Then
ligne = J
End If
If Range("A" & J) = Range("A" & ligne) And J > ligne Then
Range("C" & ligne) = Range("C" & ligne) + Range("C" & J)
Range("D" & ligne) = Range("D" & ligne) + Range("D" & J)
Range("B" & J).EntireRow.ClearContents
End If
If Range("A" & J) <> Range("A" & J + 1) Then
If Range("C" & ligne) < Range("D" & ligne) Then
Range("D" & ligne) = Range("D" & ligne) - Range("C" & ligne)
Range("C" & ligne) = ""
End If
If Range("C" & ligne) > Range("D" & ligne) Then
Range("C" & ligne) = Range("C" & ligne) - Range("D" & ligne)
Range("D" & ligne) = ""
End If
If Range("C" & ligne) = Range("D" & ligne) Then
Range("C" & ligne) = ""
Range("D" & ligne) = ""
End If
End If
J = J + 1
Loop
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Sort
Key1:=Sheets("GA14").Range("A3"), Order1:=xlAscending
Sheets("GA14").Range("A" &
Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0).Row,
"A65535").EntireRow.Delete
'insertion de la colonne C pour la présentation
Sheets("GA14").Columns("C:C").Insert Shift:=xlToRight
Sheets("GA14").Columns("C:C").ColumnWidth = 3
Sheets("GA10").Protect
'Sheets("GA14").Protect
'mettre tous les chiffres au bon format
Sheets("GA14").Columns("D:G").NumberFormat = "#,##0.00"
Sheets("GA14").Range("G1").NumberFormat = "dd/mm/yy;@"
'mettre un quadrillage à blanc sur GA14
Sheets("GA14").Cells.Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlDiagonalUp).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeLeft).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeTop).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeBottom).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeRight).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlInsideVertical).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
'verouiller l'onglet GA14
Sheets("GA14").Cells.Locked = True
Sheets("GA14").Cells.FormulaHidden = False
Sheets("GA14").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("GA14").EnableSelection = xlNoRestrictions
End Sub
------
ma macro 2 :
------
Sub Import10()
'supprimer les anciennes lignes
Application.Calculation = xlManual
Application.ScreenUpdating = False
Sheets("10").Activate
For I = Cells(Rows.Count, "a").End(1).Row To 2 Step -1
If Cells(I, 1) > 100000 And Cells(I, 1) < 99999999 Then Rows(I).Delete
Next
'ajoute les lignes
Sheets("10").Select
Range("DETAIL10").Select
On Error Resume Next
For Each C In Worksheets("GA14").Range("A2:A1000")
n1 = Mid(C, 1, 1)
n2 = Mid(C, 1, 4)
n4 = Mid(C, 1, 4)
n5 = Mid(C, 1, 4)
n10 = Mid(C, 1, 4)
n11 = Mid(C, 1, 4)
n12 = Mid(C, 1, 4)
n13 = Mid(C, 1, 3)
n14 = Mid(C, 1, 4)
If n1 = 1 Or n2 = 6611 Or n4 = 6874 Or n5 = 6875 _
Or n10 = 7865 Or n11 = 7874 Or n12 = 7875 Or n13 = 777 Or n14 = 7872 _
Then
Selection.EntireRow.Insert Shift:=xlDown
ActiveCell.Offset(0, 0).Select
Range(C, C.Offset(0, 255).End(xlToLeft)).Copy
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
End If
Next
Application.Calculation = xlAutomatic
End Sub
------
ma macro 3 : (après je ferrais tout seul)
-----
Sub Import20()
'supprimer les anciennes lignes
Application.Calculation = xlManual
Application.ScreenUpdating = False
Sheets("20").Activate
For I = Cells(Rows.Count, "a").End(1).Row To 2 Step -1
If Cells(I, 1) > 100000 And Cells(I, 1) < 99999999 Then Rows(I).Delete
Next
'ajoute les lignes
Sheets("20").Select
Range("DETAIL20").Select
On Error Resume Next
For Each C In Worksheets("GA14").Range("A2:A1000")
n1 = Mid(C, 1, 1)
n2 = Mid(C, 1, 3)
n3 = Mid(C, 1, 3)
n4 = Mid(C, 1, 4)
n5 = Mid(C, 1, 4)
n6 = Mid(C, 1, 4)
n7 = Mid(C, 1, 4)
n11 = Mid(C, 1, 3)
n12 = Mid(C, 1, 4)
n13 = Mid(C, 1, 4)
n14 = Mid(C, 1, 4)
If n1 = 2 Or n2 = 664 Or n3 = 675 Or n4 = 6811 Or n5 = 6816 Or n6 = 6871 Or
n7 = 6872 _
Or n11 = 775 Or n12 = 7811 Or n13 = 7816 Or n14 = 4962 _
Then
Selection.EntireRow.Insert Shift:=xlDown
ActiveCell.Offset(0, 0).Select
Range(C, C.Offset(0, 255).End(xlToLeft)).Copy
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
End If
Next
Application.Calculation = xlAutomatic
End Sub
-----

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour,
j'ai plusieur macros que je voudrais executer par un seul et meme bouton.
en effet, je clique sur mon bouton, la macro 1 se fait, puis la macro, puis
la 3, et ainsi de suite.
comment structurer ma macro ??
MERCI beaucoup.
YANN
voici ma macro1:
-----
Sub CalculBalLive()
'supprime la colonne C
Sheets("GA14").Columns("C:C").Delete Shift:=xlToLeft
'calcul de la balance en temps réel
Sheets("GA10").Unprotect
Sheets("GA14").Unprotect
If Sheets("GA14").Range("A3") <> "" Then
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Clear
End If
Sheets("GA10").Range("A3", "F" &
Sheets("GA10").Range("A65535").End(xlUp).Row).Copy
Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0)
For Each I In Sheets(Array("GA11", "GA12", "GA13"))
If I.Range("C12") <> "" Then
Départ = Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0).Row
I.Range("C12", "F" & I.Range("C65535").End(xlUp).Row).Copy
Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0)
I.Range("H12", "H" & I.Range("H65535").End(xlUp).Row).Copy
Sheets("GA14").Range("B" & Départ)
End If
Next
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Interior.ColorIndex = xlNone
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Sort
Key1:=Sheets("GA14").Range("A3"), Order1:=xlAscending
J = 3
ligne = 2
Do While Range("A" & J).Row < Range("A65535").End(xlUp).Offset(1, 0).Row
If Range("A" & J) <> Range("A" & J - 1) And Range("A" & J) <> Range("A" &
ligne) Then
ligne = J
End If
If Range("A" & J) = Range("A" & ligne) And J > ligne Then
Range("C" & ligne) = Range("C" & ligne) + Range("C" & J)
Range("D" & ligne) = Range("D" & ligne) + Range("D" & J)
Range("B" & J).EntireRow.ClearContents
End If
If Range("A" & J) <> Range("A" & J + 1) Then
If Range("C" & ligne) < Range("D" & ligne) Then
Range("D" & ligne) = Range("D" & ligne) - Range("C" & ligne)
Range("C" & ligne) = ""
End If
If Range("C" & ligne) > Range("D" & ligne) Then
Range("C" & ligne) = Range("C" & ligne) - Range("D" & ligne)
Range("D" & ligne) = ""
End If
If Range("C" & ligne) = Range("D" & ligne) Then
Range("C" & ligne) = ""
Range("D" & ligne) = ""
End If
End If
J = J + 1
Loop
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Sort
Key1:=Sheets("GA14").Range("A3"), Order1:=xlAscending
Sheets("GA14").Range("A" &
Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0).Row,
"A65535").EntireRow.Delete
'insertion de la colonne C pour la présentation
Sheets("GA14").Columns("C:C").Insert Shift:=xlToRight
Sheets("GA14").Columns("C:C").ColumnWidth = 3
Sheets("GA10").Protect
'Sheets("GA14").Protect
'mettre tous les chiffres au bon format
Sheets("GA14").Columns("D:G").NumberFormat = "#,##0.00"
Sheets("GA14").Range("G1").NumberFormat = "dd/mm/yy;@"
'mettre un quadrillage à blanc sur GA14
Sheets("GA14").Cells.Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlDiagonalUp).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeLeft).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeTop).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeBottom).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeRight).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlInsideVertical).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
'verouiller l'onglet GA14
Sheets("GA14").Cells.Locked = True
Sheets("GA14").Cells.FormulaHidden = False
Sheets("GA14").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("GA14").EnableSelection = xlNoRestrictions
End Sub
------
ma macro 2 :
------
Sub Import10()
'supprimer les anciennes lignes
Application.Calculation = xlManual
Application.ScreenUpdating = False
Sheets("10").Activate
For I = Cells(Rows.Count, "a").End(1).Row To 2 Step -1
If Cells(I, 1) > 100000 And Cells(I, 1) < 99999999 Then Rows(I).Delete
Next
'ajoute les lignes
Sheets("10").Select
Range("DETAIL10").Select
On Error Resume Next
For Each C In Worksheets("GA14").Range("A2:A1000")
n1 = Mid(C, 1, 1)
n2 = Mid(C, 1, 4)
n4 = Mid(C, 1, 4)
n5 = Mid(C, 1, 4)
n10 = Mid(C, 1, 4)
n11 = Mid(C, 1, 4)
n12 = Mid(C, 1, 4)
n13 = Mid(C, 1, 3)
n14 = Mid(C, 1, 4)
If n1 = 1 Or n2 = 6611 Or n4 = 6874 Or n5 = 6875 _
Or n10 = 7865 Or n11 = 7874 Or n12 = 7875 Or n13 = 777 Or n14 = 7872 _
Then
Selection.EntireRow.Insert Shift:=xlDown
ActiveCell.Offset(0, 0).Select
Range(C, C.Offset(0, 255).End(xlToLeft)).Copy
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
End If
Next
Application.Calculation = xlAutomatic
End Sub
------
ma macro 3 : (après je ferrais tout seul)
-----
Sub Import20()
'supprimer les anciennes lignes
Application.Calculation = xlManual
Application.ScreenUpdating = False
Sheets("20").Activate
For I = Cells(Rows.Count, "a").End(1).Row To 2 Step -1
If Cells(I, 1) > 100000 And Cells(I, 1) < 99999999 Then Rows(I).Delete
Next
'ajoute les lignes
Sheets("20").Select
Range("DETAIL20").Select
On Error Resume Next
For Each C In Worksheets("GA14").Range("A2:A1000")
n1 = Mid(C, 1, 1)
n2 = Mid(C, 1, 3)
n3 = Mid(C, 1, 3)
n4 = Mid(C, 1, 4)
n5 = Mid(C, 1, 4)
n6 = Mid(C, 1, 4)
n7 = Mid(C, 1, 4)
n11 = Mid(C, 1, 3)
n12 = Mid(C, 1, 4)
n13 = Mid(C, 1, 4)
n14 = Mid(C, 1, 4)
If n1 = 2 Or n2 = 664 Or n3 = 675 Or n4 = 6811 Or n5 = 6816 Or n6 = 6871 Or
n7 = 6872 _
Or n11 = 775 Or n12 = 7811 Or n13 = 7816 Or n14 = 4962 _
Then
Selection.EntireRow.Insert Shift:=xlDown
ActiveCell.Offset(0, 0).Select
Range(C, C.Offset(0, 255).End(xlToLeft)).Copy
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
End If
Next
Application.Calculation = xlAutomatic
End Sub
-----

Coetera

30/01/2009 à 16:21

> j'ai plusieur macros que je voudrais executer par un seul et meme bouton.
en effet, je clique sur mon bouton, la macro 1 se fait, puis la macro, puis
la 3, et ainsi de suite.
comment structurer ma macro ??

************

Sub macro_à_affecter_au_bouton
macro1 'exécution de la macro1
macro2 'exécution de la macro2
macro3 'exécution de la macro3
End sub

Etc

garnote

30/01/2009 à 16:22

Quelque chose du genre, peut-être :

Sub Trois()
Call CalculBalLive
Call Import10
Call Import20
End Sub

Serge

"Sunburn" a écrit dans le message de news:

Bonjour,
j'ai plusieur macros que je voudrais executer par un seul et meme bouton.
en effet, je clique sur mon bouton, la macro 1 se fait, puis la macro, puis
la 3, et ainsi de suite.
comment structurer ma macro ??
MERCI beaucoup.
YANN
voici ma macro1:
-----
Sub CalculBalLive()
'supprime la colonne C
Sheets("GA14").Columns("C:C").Delete Shift:=xlToLeft
'calcul de la balance en temps réel
Sheets("GA10").Unprotect
Sheets("GA14").Unprotect
If Sheets("GA14").Range("A3") <> "" Then
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Clear
End If
Sheets("GA10").Range("A3", "F" &
Sheets("GA10").Range("A65535").End(xlUp).Row).Copy
Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0)
For Each I In Sheets(Array("GA11", "GA12", "GA13"))
If I.Range("C12") <> "" Then
Départ = Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0).Row
I.Range("C12", "F" & I.Range("C65535").End(xlUp).Row).Copy
Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0)
I.Range("H12", "H" & I.Range("H65535").End(xlUp).Row).Copy
Sheets("GA14").Range("B" & Départ)
End If
Next
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Interior.ColorIndex = xlNone
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Sort
Key1:=Sheets("GA14").Range("A3"), Order1:=xlAscending
J = 3
ligne = 2
Do While Range("A" & J).Row < Range("A65535").End(xlUp).Offset(1, 0).Row
If Range("A" & J) <> Range("A" & J - 1) And Range("A" & J) <> Range("A" &
ligne) Then
ligne = J
End If
If Range("A" & J) = Range("A" & ligne) And J > ligne Then
Range("C" & ligne) = Range("C" & ligne) + Range("C" & J)
Range("D" & ligne) = Range("D" & ligne) + Range("D" & J)
Range("B" & J).EntireRow.ClearContents
End If
If Range("A" & J) <> Range("A" & J + 1) Then
If Range("C" & ligne) < Range("D" & ligne) Then
Range("D" & ligne) = Range("D" & ligne) - Range("C" & ligne)
Range("C" & ligne) = ""
End If
If Range("C" & ligne) > Range("D" & ligne) Then
Range("C" & ligne) = Range("C" & ligne) - Range("D" & ligne)
Range("D" & ligne) = ""
End If
If Range("C" & ligne) = Range("D" & ligne) Then
Range("C" & ligne) = ""
Range("D" & ligne) = ""
End If
End If
J = J + 1
Loop
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Sort
Key1:=Sheets("GA14").Range("A3"), Order1:=xlAscending
Sheets("GA14").Range("A" &
Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0).Row,
"A65535").EntireRow.Delete
'insertion de la colonne C pour la présentation
Sheets("GA14").Columns("C:C").Insert Shift:=xlToRight
Sheets("GA14").Columns("C:C").ColumnWidth = 3
Sheets("GA10").Protect
'Sheets("GA14").Protect
'mettre tous les chiffres au bon format
Sheets("GA14").Columns("D:G").NumberFormat = "#,##0.00"
Sheets("GA14").Range("G1").NumberFormat = "dd/mm/yy;@"
'mettre un quadrillage à blanc sur GA14
Sheets("GA14").Cells.Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlDiagonalUp).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeLeft).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeTop).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeBottom).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeRight).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlInsideVertical).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
'verouiller l'onglet GA14
Sheets("GA14").Cells.Locked = True
Sheets("GA14").Cells.FormulaHidden = False
Sheets("GA14").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("GA14").EnableSelection = xlNoRestrictions
End Sub
------
ma macro 2 :
------
Sub Import10()
'supprimer les anciennes lignes
Application.Calculation = xlManual
Application.ScreenUpdating = False
Sheets("10").Activate
For I = Cells(Rows.Count, "a").End(1).Row To 2 Step -1
If Cells(I, 1) > 100000 And Cells(I, 1) < 99999999 Then Rows(I).Delete
Next
'ajoute les lignes
Sheets("10").Select
Range("DETAIL10").Select
On Error Resume Next
For Each C In Worksheets("GA14").Range("A2:A1000")
n1 = Mid(C, 1, 1)
n2 = Mid(C, 1, 4)
n4 = Mid(C, 1, 4)
n5 = Mid(C, 1, 4)
n10 = Mid(C, 1, 4)
n11 = Mid(C, 1, 4)
n12 = Mid(C, 1, 4)
n13 = Mid(C, 1, 3)
n14 = Mid(C, 1, 4)
If n1 = 1 Or n2 = 6611 Or n4 = 6874 Or n5 = 6875 _
Or n10 = 7865 Or n11 = 7874 Or n12 = 7875 Or n13 = 777 Or n14 = 7872 _
Then
Selection.EntireRow.Insert Shift:=xlDown
ActiveCell.Offset(0, 0).Select
Range(C, C.Offset(0, 255).End(xlToLeft)).Copy
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
End If
Next
Application.Calculation = xlAutomatic
End Sub
------
ma macro 3 : (après je ferrais tout seul)
-----
Sub Import20()
'supprimer les anciennes lignes
Application.Calculation = xlManual
Application.ScreenUpdating = False
Sheets("20").Activate
For I = Cells(Rows.Count, "a").End(1).Row To 2 Step -1
If Cells(I, 1) > 100000 And Cells(I, 1) < 99999999 Then Rows(I).Delete
Next
'ajoute les lignes
Sheets("20").Select
Range("DETAIL20").Select
On Error Resume Next
For Each C In Worksheets("GA14").Range("A2:A1000")
n1 = Mid(C, 1, 1)
n2 = Mid(C, 1, 3)
n3 = Mid(C, 1, 3)
n4 = Mid(C, 1, 4)
n5 = Mid(C, 1, 4)
n6 = Mid(C, 1, 4)
n7 = Mid(C, 1, 4)
n11 = Mid(C, 1, 3)
n12 = Mid(C, 1, 4)
n13 = Mid(C, 1, 4)
n14 = Mid(C, 1, 4)
If n1 = 2 Or n2 = 664 Or n3 = 675 Or n4 = 6811 Or n5 = 6816 Or n6 = 6871 Or
n7 = 6872 _
Or n11 = 775 Or n12 = 7811 Or n13 = 7816 Or n14 = 4962 _
Then
Selection.EntireRow.Insert Shift:=xlDown
ActiveCell.Offset(0, 0).Select
Range(C, C.Offset(0, 255).End(xlToLeft)).Copy
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
End If
Next
Application.Calculation = xlAutomatic
End Sub
-----

Quelque chose du genre, peut-être :

Sub Trois()
Call CalculBalLive
Call Import10
Call Import20
End Sub

Serge

"Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message de news:
7FA6F48E-8498-4DB9-A8A4-7F4494E9FE0C@microsoft.com...

Bonjour,
j'ai plusieur macros que je voudrais executer par un seul et meme bouton.
en effet, je clique sur mon bouton, la macro 1 se fait, puis la macro, puis
la 3, et ainsi de suite.
comment structurer ma macro ??
MERCI beaucoup.
YANN
voici ma macro1:
-----
Sub CalculBalLive()
'supprime la colonne C
Sheets("GA14").Columns("C:C").Delete Shift:=xlToLeft
'calcul de la balance en temps réel
Sheets("GA10").Unprotect
Sheets("GA14").Unprotect
If Sheets("GA14").Range("A3") <> "" Then
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Clear
End If
Sheets("GA10").Range("A3", "F" &
Sheets("GA10").Range("A65535").End(xlUp).Row).Copy
Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0)
For Each I In Sheets(Array("GA11", "GA12", "GA13"))
If I.Range("C12") <> "" Then
Départ = Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0).Row
I.Range("C12", "F" & I.Range("C65535").End(xlUp).Row).Copy
Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0)
I.Range("H12", "H" & I.Range("H65535").End(xlUp).Row).Copy
Sheets("GA14").Range("B" & Départ)
End If
Next
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Interior.ColorIndex = xlNone
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Sort
Key1:=Sheets("GA14").Range("A3"), Order1:=xlAscending
J = 3
ligne = 2
Do While Range("A" & J).Row < Range("A65535").End(xlUp).Offset(1, 0).Row
If Range("A" & J) <> Range("A" & J - 1) And Range("A" & J) <> Range("A" &
ligne) Then
ligne = J
End If
If Range("A" & J) = Range("A" & ligne) And J > ligne Then
Range("C" & ligne) = Range("C" & ligne) + Range("C" & J)
Range("D" & ligne) = Range("D" & ligne) + Range("D" & J)
Range("B" & J).EntireRow.ClearContents
End If
If Range("A" & J) <> Range("A" & J + 1) Then
If Range("C" & ligne) < Range("D" & ligne) Then
Range("D" & ligne) = Range("D" & ligne) - Range("C" & ligne)
Range("C" & ligne) = ""
End If
If Range("C" & ligne) > Range("D" & ligne) Then
Range("C" & ligne) = Range("C" & ligne) - Range("D" & ligne)
Range("D" & ligne) = ""
End If
If Range("C" & ligne) = Range("D" & ligne) Then
Range("C" & ligne) = ""
Range("D" & ligne) = ""
End If
End If
J = J + 1
Loop
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Sort
Key1:=Sheets("GA14").Range("A3"), Order1:=xlAscending
Sheets("GA14").Range("A" &
Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0).Row,
"A65535").EntireRow.Delete
'insertion de la colonne C pour la présentation
Sheets("GA14").Columns("C:C").Insert Shift:=xlToRight
Sheets("GA14").Columns("C:C").ColumnWidth = 3
Sheets("GA10").Protect
'Sheets("GA14").Protect
'mettre tous les chiffres au bon format
Sheets("GA14").Columns("D:G").NumberFormat = "#,##0.00"
Sheets("GA14").Range("G1").NumberFormat = "dd/mm/yy;@"
'mettre un quadrillage à blanc sur GA14
Sheets("GA14").Cells.Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlDiagonalUp).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeLeft).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeTop).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeBottom).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeRight).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlInsideVertical).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
'verouiller l'onglet GA14
Sheets("GA14").Cells.Locked = True
Sheets("GA14").Cells.FormulaHidden = False
Sheets("GA14").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("GA14").EnableSelection = xlNoRestrictions
End Sub
------
ma macro 2 :
------
Sub Import10()
'supprimer les anciennes lignes
Application.Calculation = xlManual
Application.ScreenUpdating = False
Sheets("10").Activate
For I = Cells(Rows.Count, "a").End(1).Row To 2 Step -1
If Cells(I, 1) > 100000 And Cells(I, 1) < 99999999 Then Rows(I).Delete
Next
'ajoute les lignes
Sheets("10").Select
Range("DETAIL10").Select
On Error Resume Next
For Each C In Worksheets("GA14").Range("A2:A1000")
n1 = Mid(C, 1, 1)
n2 = Mid(C, 1, 4)
n4 = Mid(C, 1, 4)
n5 = Mid(C, 1, 4)
n10 = Mid(C, 1, 4)
n11 = Mid(C, 1, 4)
n12 = Mid(C, 1, 4)
n13 = Mid(C, 1, 3)
n14 = Mid(C, 1, 4)
If n1 = 1 Or n2 = 6611 Or n4 = 6874 Or n5 = 6875 _
Or n10 = 7865 Or n11 = 7874 Or n12 = 7875 Or n13 = 777 Or n14 = 7872 _
Then
Selection.EntireRow.Insert Shift:=xlDown
ActiveCell.Offset(0, 0).Select
Range(C, C.Offset(0, 255).End(xlToLeft)).Copy
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
End If
Next
Application.Calculation = xlAutomatic
End Sub
------
ma macro 3 : (après je ferrais tout seul)
-----
Sub Import20()
'supprimer les anciennes lignes
Application.Calculation = xlManual
Application.ScreenUpdating = False
Sheets("20").Activate
For I = Cells(Rows.Count, "a").End(1).Row To 2 Step -1
If Cells(I, 1) > 100000 And Cells(I, 1) < 99999999 Then Rows(I).Delete
Next
'ajoute les lignes
Sheets("20").Select
Range("DETAIL20").Select
On Error Resume Next
For Each C In Worksheets("GA14").Range("A2:A1000")
n1 = Mid(C, 1, 1)
n2 = Mid(C, 1, 3)
n3 = Mid(C, 1, 3)
n4 = Mid(C, 1, 4)
n5 = Mid(C, 1, 4)
n6 = Mid(C, 1, 4)
n7 = Mid(C, 1, 4)
n11 = Mid(C, 1, 3)
n12 = Mid(C, 1, 4)
n13 = Mid(C, 1, 4)
n14 = Mid(C, 1, 4)
If n1 = 2 Or n2 = 664 Or n3 = 675 Or n4 = 6811 Or n5 = 6816 Or n6 = 6871 Or
n7 = 6872 _
Or n11 = 775 Or n12 = 7811 Or n13 = 7816 Or n14 = 4962 _
Then
Selection.EntireRow.Insert Shift:=xlDown
ActiveCell.Offset(0, 0).Select
Range(C, C.Offset(0, 255).End(xlToLeft)).Copy
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
End If
Next
Application.Calculation = xlAutomatic
End Sub
-----

Vous avez filtré cet utilisateur ! Consultez son message

Quelque chose du genre, peut-être :

Sub Trois()
Call CalculBalLive
Call Import10
Call Import20
End Sub

Serge

"Sunburn" a écrit dans le message de news:

Bonjour,
j'ai plusieur macros que je voudrais executer par un seul et meme bouton.
en effet, je clique sur mon bouton, la macro 1 se fait, puis la macro, puis
la 3, et ainsi de suite.
comment structurer ma macro ??
MERCI beaucoup.
YANN
voici ma macro1:
-----
Sub CalculBalLive()
'supprime la colonne C
Sheets("GA14").Columns("C:C").Delete Shift:=xlToLeft
'calcul de la balance en temps réel
Sheets("GA10").Unprotect
Sheets("GA14").Unprotect
If Sheets("GA14").Range("A3") <> "" Then
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Clear
End If
Sheets("GA10").Range("A3", "F" &
Sheets("GA10").Range("A65535").End(xlUp).Row).Copy
Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0)
For Each I In Sheets(Array("GA11", "GA12", "GA13"))
If I.Range("C12") <> "" Then
Départ = Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0).Row
I.Range("C12", "F" & I.Range("C65535").End(xlUp).Row).Copy
Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0)
I.Range("H12", "H" & I.Range("H65535").End(xlUp).Row).Copy
Sheets("GA14").Range("B" & Départ)
End If
Next
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Interior.ColorIndex = xlNone
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Sort
Key1:=Sheets("GA14").Range("A3"), Order1:=xlAscending
J = 3
ligne = 2
Do While Range("A" & J).Row < Range("A65535").End(xlUp).Offset(1, 0).Row
If Range("A" & J) <> Range("A" & J - 1) And Range("A" & J) <> Range("A" &
ligne) Then
ligne = J
End If
If Range("A" & J) = Range("A" & ligne) And J > ligne Then
Range("C" & ligne) = Range("C" & ligne) + Range("C" & J)
Range("D" & ligne) = Range("D" & ligne) + Range("D" & J)
Range("B" & J).EntireRow.ClearContents
End If
If Range("A" & J) <> Range("A" & J + 1) Then
If Range("C" & ligne) < Range("D" & ligne) Then
Range("D" & ligne) = Range("D" & ligne) - Range("C" & ligne)
Range("C" & ligne) = ""
End If
If Range("C" & ligne) > Range("D" & ligne) Then
Range("C" & ligne) = Range("C" & ligne) - Range("D" & ligne)
Range("D" & ligne) = ""
End If
If Range("C" & ligne) = Range("D" & ligne) Then
Range("C" & ligne) = ""
Range("D" & ligne) = ""
End If
End If
J = J + 1
Loop
Sheets("GA14").Range("A3", "F" &
Sheets("GA14").Range("A65535").End(xlUp).Row).Sort
Key1:=Sheets("GA14").Range("A3"), Order1:=xlAscending
Sheets("GA14").Range("A" &
Sheets("GA14").Range("A65535").End(xlUp).Offset(1, 0).Row,
"A65535").EntireRow.Delete
'insertion de la colonne C pour la présentation
Sheets("GA14").Columns("C:C").Insert Shift:=xlToRight
Sheets("GA14").Columns("C:C").ColumnWidth = 3
Sheets("GA10").Protect
'Sheets("GA14").Protect
'mettre tous les chiffres au bon format
Sheets("GA14").Columns("D:G").NumberFormat = "#,##0.00"
Sheets("GA14").Range("G1").NumberFormat = "dd/mm/yy;@"
'mettre un quadrillage à blanc sur GA14
Sheets("GA14").Cells.Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlDiagonalUp).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeLeft).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeTop).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeBottom).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlEdgeRight).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlInsideVertical).LineStyle = xlNone
Sheets("GA14").Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
'verouiller l'onglet GA14
Sheets("GA14").Cells.Locked = True
Sheets("GA14").Cells.FormulaHidden = False
Sheets("GA14").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("GA14").EnableSelection = xlNoRestrictions
End Sub
------
ma macro 2 :
------
Sub Import10()
'supprimer les anciennes lignes
Application.Calculation = xlManual
Application.ScreenUpdating = False
Sheets("10").Activate
For I = Cells(Rows.Count, "a").End(1).Row To 2 Step -1
If Cells(I, 1) > 100000 And Cells(I, 1) < 99999999 Then Rows(I).Delete
Next
'ajoute les lignes
Sheets("10").Select
Range("DETAIL10").Select
On Error Resume Next
For Each C In Worksheets("GA14").Range("A2:A1000")
n1 = Mid(C, 1, 1)
n2 = Mid(C, 1, 4)
n4 = Mid(C, 1, 4)
n5 = Mid(C, 1, 4)
n10 = Mid(C, 1, 4)
n11 = Mid(C, 1, 4)
n12 = Mid(C, 1, 4)
n13 = Mid(C, 1, 3)
n14 = Mid(C, 1, 4)
If n1 = 1 Or n2 = 6611 Or n4 = 6874 Or n5 = 6875 _
Or n10 = 7865 Or n11 = 7874 Or n12 = 7875 Or n13 = 777 Or n14 = 7872 _
Then
Selection.EntireRow.Insert Shift:=xlDown
ActiveCell.Offset(0, 0).Select
Range(C, C.Offset(0, 255).End(xlToLeft)).Copy
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
End If
Next
Application.Calculation = xlAutomatic
End Sub
------
ma macro 3 : (après je ferrais tout seul)
-----
Sub Import20()
'supprimer les anciennes lignes
Application.Calculation = xlManual
Application.ScreenUpdating = False
Sheets("20").Activate
For I = Cells(Rows.Count, "a").End(1).Row To 2 Step -1
If Cells(I, 1) > 100000 And Cells(I, 1) < 99999999 Then Rows(I).Delete
Next
'ajoute les lignes
Sheets("20").Select
Range("DETAIL20").Select
On Error Resume Next
For Each C In Worksheets("GA14").Range("A2:A1000")
n1 = Mid(C, 1, 1)
n2 = Mid(C, 1, 3)
n3 = Mid(C, 1, 3)
n4 = Mid(C, 1, 4)
n5 = Mid(C, 1, 4)
n6 = Mid(C, 1, 4)
n7 = Mid(C, 1, 4)
n11 = Mid(C, 1, 3)
n12 = Mid(C, 1, 4)
n13 = Mid(C, 1, 4)
n14 = Mid(C, 1, 4)
If n1 = 2 Or n2 = 664 Or n3 = 675 Or n4 = 6811 Or n5 = 6816 Or n6 = 6871 Or
n7 = 6872 _
Or n11 = 775 Or n12 = 7811 Or n13 = 7816 Or n14 = 4962 _
Then
Selection.EntireRow.Insert Shift:=xlDown
ActiveCell.Offset(0, 0).Select
Range(C, C.Offset(0, 255).End(xlToLeft)).Copy
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
End If
Next
Application.Calculation = xlAutomatic
End Sub
-----

enchainé plusieurs code en une meme macro

3 réponses

Veuillez sélectionner un problème