Option Explicit
Sub test()
Dim a, i As Long, j As Long, n As Long, e, s, dico As Object, txt As String
a = Sheets("GRAND LIVRE").[a1].CurrentRegion.Value
Set dico = CreateObject("Scripting.Dictionary")
dico.Comparemode = 1
For j = 14 To UBound(a, 2)
If j <> 14 And j <> 36 And j <> 37 And j <> 52 Then
If a(1, j) = "" Then a(1, j) = a(1, j - 1)
If Not dico.exists(a(1, j)) Then
Set dico(a(1, j)) = CreateObject("Scripting.Dictionary")
End If
For i = 4 To UBound(a, 1) - 2
txt = Join$(Array(a(i, 1), a(i, 6)), "|")
If Not dico(a(1, j)).exists(txt) Then
Set dico(a(1, j))(txt) = CreateObject("Scripting.Dictionary")
dico(a(1, j))(txt).Comparemode = 1
End If
If Not dico(a(1, j))(txt).exists(a(2, j)) Then
dico(a(1, j))(txt)(a(2, j)) = a(i, j)
End If
Next
End If
Next
For Each e In dico.keys
For Each s In dico.Item(e).keys
If Application.Count(dico(e).Item(s).items) = 0 Then dico(e).Remove s
Next
Next
For Each e In dico.keys
If dico(e).Count = 0 Then
dico.Remove e
End If
Next
If dico.Count = 0 Then MsgBox "aucune donnée à traiter": Set dico = Nothing: Exit Sub
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
For Each e In dico.keys
On Error Resume Next
Application.DisplayAlerts = False
Sheets(e).Delete
Sheets.Add(Before:=Sheets("GRAND LIVRE")).Name = e
On Error GoTo 0
With Sheets(e)
n = 0
.Cells(1, 3).Value = e
.Cells(2, 1).Resize(, 2).Value = Array("N° piéces", "Libellés")
.Cells(2, 3).Resize(, dico(e).items()(0).Count).Value = dico(e).items()(0).keys()
For Each s In dico.Item(e).keys
.Cells(3 + n, 1).Resize(, 2).Value = Array(Split(s, "|")(0), Split(s, "|")(1))
.Cells(3 + n, 3).Resize(, dico(e).Item(s).Count).Value = dico(e).Item(s).items
n = n + 1
Next
With .Cells(1)
With .CurrentRegion
With .Offset(.Rows.Count)
.Columns(1).Resize(1, 2).Value = Array("---", "Totaux")
'les sommes en bout de colonnes
.Columns(3).Resize(1, .Columns.Count - 2).Formula = "=sum(r3c:r[-1]c)"
End With
With .Offset(, .Columns.Count)
.Rows(2).Resize(1, 1).Value = "Total " & e
'les sommes en bout de lignes
.Rows(3).Resize(.Rows.Count - 1, 1).Formula = "=sum(rc3:rc[-1])"
End With
End With
With .CurrentRegion
.VerticalAlignment = xlCenter
With .Font
.Name = "calibri"
.Size = 9
End With
With .Rows(1)
.RowHeight = 22
With .Offset(, 2).Resize(, .Columns.Count - 3)
.HorizontalAlignment = xlCenterAcrossSelection
With .Font
.Size = 12: .Bold = True
If e = "DEPENSES" Then
.ColorIndex = 53
Else
.ColorIndex = 55
End If
End With
End With
End With
With .Offset(1).Resize(.Rows.Count - 1)
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
With .Rows(1)
.RowHeight = 20
.HorizontalAlignment = xlCenter
.Font.Size = 10
.BorderAround Weight:=xlThin
With .Offset(, 2).Resize(, .Columns.Count - 3)
With .Interior
If e = "DEPENSES" Then
.ColorIndex = 40
Else
.ColorIndex = 37
End If
End With
End With
End With
With .Rows(.Rows.Count)
.BorderAround Weight:=xlThin
With .Offset(, 2).Resize(, .Columns.Count - 3)
With .Interior
If e = "DEPENSES" Then
.ColorIndex = 40
Else
.ColorIndex = 37
End If
End With
End With
End With
With .Columns(1).Resize(, 2)
.HorizontalAlignment = xlCenter
End With
With .Offset(1, 2).Resize(.Rows.Count - 1, .Columns.Count - 2)
.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00"
With .Resize(, .Columns.Count - 1)
.Borders(xlInsideVertical).Weight = xlHairline
End With
End With
End With
.Columns.AutoFit
End With
End With
End With
Next
Sheets("GRAND LIVRE").Move Before:=Sheets(dico.keys()(0))
Set dico = Nothing
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
, désolé pour la collision pas rafraichi mais content de te croiser
