Private Sub Worksheet_Activate() 'Private Sub CommandButton1_Click()
Dim a, n As Byte, i, j, w As Worksheet, t, h&, k&, b(), c()
a = Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", _
"Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For n = 1 To 13 'à adapter éventuellement
i = Application.Match("*(" & n & ")", [B:B], 0)
If IsNumeric(i) Then
j = Application.Match("TOTAL*", Range(Cells(i + 1, 2), Range("B" & Rows.Count)), 0)
If IsNumeric(j) Then
If j > 3 Then Rows(i + 2).Resize(j - 3).Delete 'RAZ
For j = 11 To 0 Step -1 'de décembre à janvier
Set w = Nothing
On Error Resume Next 'si la feuille n'existe pas
Set w = Sheets(a(j))
On Error GoTo 0
If Not w Is Nothing Then
t = w.Range("A11:E" & w.Range("B" & w.Rows.Count).End(xlUp).Row).Value2
h = 0
For k = 1 To UBound(t)
If t(k, 2) = n Then
h = h + 1
ReDim Preserve b(1 To 3, 1 To h)
ReDim Preserve c(1 To h)
b(1, h) = t(k, 3): b(2, h) = t(k, 4): b(3, h) = t(k, 5)
c(h) = t(k, 1)
End If
Next k
If h Then
Rows(i + 2).Resize(h).Insert 'insertion de h lignes
Cells(i + 2, 2).Resize(h, 3) = Application.Transpose(b)
Cells(i + 2, 1).Resize(h) = Application.Transpose(c)
End If
End If
Next j
End If
End If
Next n
[C:D].NumberFormat = "#,##0.00 €" 'au cas où
[A:A].NumberFormat = "dd-mmmm-yy"
Application.Calculation = xlCalculationAutomatic
End Sub