Sub MAJ()
Dim result(), dico As Object
Set dico = CreateObject("Scripting.Dictionary")
tbl = Sheets("Mouvements").Range("A1").CurrentRegion.Value
With Sheets("Actions")
.Range("A8").CurrentRegion.ClearContents
k = 1
ReDim result(1 To UBound(tbl, 2) - 2, 1 To k)
For i = LBound(tbl) + 1 To UBound(tbl)
If tbl(i, 4) Like .Name & "*" Then
If dico.Exists(tbl(i, 3)) Then
For j = 6 To 7
result(j - 2, dico(tbl(i, 3))) = result(j - 2, dico(tbl(i, 3))) + tbl(i, j)
Next
Else
dico(tbl(i, 3)) = k
For j = 3 To 7
result(j - 2, k) = tbl(i, j)
Next
k = k + 1
End If
ReDim Preserve result(1 To UBound(tbl, 2) - 2, 1 To k)
End If
Next
.Range("A8").Resize(UBound(result, 2), UBound(result)) = Application.Transpose(result)
End With
dico.RemoveAll
With Sheets("OPCVM")
.Range("A8").CurrentRegion.ClearContents
k = 1
ReDim result(1 To UBound(tbl, 2) - 2, 1 To k)
For i = LBound(tbl) + 1 To UBound(tbl)
If tbl(i, 4) Like .Name & "*" Then
If dico.Exists(tbl(i, 3)) Then
For j = 6 To 7
result(j - 2, dico(tbl(i, 3))) = result(j - 2, dico(tbl(i, 3))) + tbl(i, j)
Next
Else
dico(tbl(i, 3)) = k
For j = 3 To 7
result(j - 2, k) = tbl(i, j)
Next
k = k + 1
End If
ReDim Preserve result(1 To UBound(tbl, 2) - 2, 1 To k)
End If
Next
.Range("A8").Resize(UBound(result, 2), UBound(result)) = Application.Transpose(result)
End With
End Sub