Rassembler deux macro

[flamilo]

Bonjour, j'aimerai rassembler deux pour n'avoir qu'un bouton :

La premiere permet de récolter toutes les informations des feuilles dans la premieres :

Sub Actualiser()
Application.ScreenUpdating = False
Sheets("Synthèse").Rows("2:" & Range("A65535").End(xlUp).Row + 1).ClearContents
For i = 3 To Sheets.Count
derligne = Sheets("Synthèse").Range("A65535").End(xlUp).Row + 1
If Sheets(i).Name <> "Synthèse" Then
With Sheets("Synthèse")
.Cells(derligne, 1).Value = Sheets(i).[E1]
.Cells(derligne, 2).Value = Sheets(i).[E2]
.Cells(derligne, 3).Value = Sheets(i).[E4]
.Cells(derligne, 4).Value = Sheets(i).[F4]
.Cells(derligne, 5).Value = Sheets(i).[E6]
.Cells(derligne, 6).Value = Sheets(i).[E7]
.Cells(derligne, 7).Value = Sheets(i).[E9]
.Cells(derligne, 8).Value = Sheets(i).[E10]
.Cells(derligne, 9).Value = Sheets(i).[E11]
.Cells(derligne, 10).Value = Sheets(i).[F40]

End With
End If
Next i
End Sub


La deuxieme permet de sauter une ligne à chaque fois que la mois change dans ma colonne date, j'aimerai garder la premiere tout en respectant les conditions de la deuxieme. Est-ce possible ?

Sub Mois()
Dim Mois1 As String, Mois2 As String
Dim Y As Long, NbrLignes As Long
Cells.Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
NbrLignes = Cells(Rows.Count, 2).End(xlUp).Row
For Y = NbrLignes To 3 Step -1
Mois1 = Format(Cells(Y, 2), "mm")
Mois2 = Format(Cells(Y - 1, 2), "mm")
If Mois1 <> Mois2 Then
Rows(Y & ":" & Y).Select
Selection.Insert Shift:=xlDown
End If
Next Y
End Sub

 

[laurent950]

Re : Rassembler deux macro

Bonjour,

Je suis pas très sur de la syntaxe mais :

Sub deuxEnUneMacro()
call Actualiser
call Mois
End Sub

Laurent