Aide sur macro enregistrée

Bonjour à tous,

N'étant pas un expert en VBA, j'ai automatisé un de mes fichiers en créant une macro par enregistrement de macros.

Si le résultat est convenable, il reste néanmoins quelques petits beugs qui m'empêchent de dupliquer cette macro sur d'autres fichiers.

Le principe de cette macro et de récupérer des informations d'un tableau (source) et de copier, d'organiser, de calculer et de trier ces informations dans un autre tableau (cible).

Le soucis est quand j'utilise des données plus ou moins importantes dans le tableau source, certaines lignes ou colonnes du tableau cible ne sont pas gérées.

Je fourni le fichier en exemple

Si quelqu'un à une idée ?

Merci d'avance

Cordialement

Bonjour Yolojo,

Sans faire de macro mais simplement un tableau croisé dynamique te permettrait d'avoir ce que tu recherches il me semble.

En revanche je ne suis pas sûr de pouvoir faire un Tableau croisé avec excel 2010. Après vérification c'est tout à fait possible. Ci-joint un petit essai.

Salut Yolobo,
Salut fcyspm30,

premier jet en VBA...
Un double-clic sur la cellule orange "R E C A P" fait le boulot sans fioritures.
C'est presque plus long de préparer 'RECAP' que de faire le calcul...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, tRec(), iIdx%, iFlag1%, iFlag2%
'
If Target = "R E C A P" Then
    Cancel = True
    iFlag1 = WorksheetFunction.Max(Columns(3))
    For x = 5 To Range("F" & Rows.Count).End(xlUp).Row
        If CInt(Split(Range("F" & x).Value, "-")(0)) > iFlag2 Then iFlag2 = CInt(Split(Range("F" & x).Value, "-")(0))
    Next
    ReDim tRec(1 To iFlag1 + 1, 1 To iFlag2 + 2)
    tTab = Range("C5").Resize(Range("A" & Rows.Count).End(xlUp).Row - 4, 6).Value
    tRec(1, 1) = "Matricule"
    tRec(1, 2) = "Bénéficiaire"
    For x = 1 To UBound(tTab, 1)
        tRec(1, CInt(Split(tTab(x, 4), "-")(0)) + 2) = tTab(x, 4)       'libellé produit
        tRec(CInt(tTab(x, 1)) + 1, 1) = CInt(tTab(x, 1))                'n° matricule
        tRec(CInt(tTab(x, 1)) + 1, 2) = tTab(x, 2)                      'bénéficiaire
        tRec(CInt(tTab(x, 1)) + 1, CInt(Split(tTab(x, 4), "-")(0)) + 2) = _
            CInt(tRec(CInt(tTab(x, 1) + 1), CInt(Split(tTab(x, 4), "-")(0)) + 2)) + CInt(tTab(x, 6))        'addition produit
    Next
    With Worksheets("Recap")
        .Range("A6:Z" & .Range("A" & Rows.Count).End(xlUp).Row + 1).Clear
        .Range("A6").Resize(iFlag1 + 1, iFlag2 + 2).Value = tRec
        .Columns.AutoFit
        .Activate
        .Range("A1:O1").Select
        ActiveWindow.Zoom = True
        .[A1].Select
    End With
End If
'
End Sub

A+

Et en chipotant un peu avec 'RECAP'

    With Worksheets("Recap")
        .Range("A6:Z" & .Range("A" & Rows.Count).End(xlUp).Row + 1).Clear
        .Range("A6").Resize(iFlag1 + 1, iFlag2 + 2).Value = tRec
        On Error Resume Next
        .Range("A7:A" & .Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        On Error GoTo 0
        iRow = .Range("A" & Rows.Count).End(xlUp).Row
        iCol = .Cells(6, Columns.Count).End(xlToLeft).Column
        For x = iCol To 3 Step -1
            If .Cells(6, x) = "" Then .Range(Chr(64 + x + 1) & "6:Z" & iRow).Copy _
                Destination:=.Range(Chr(64 + x) & 6)
            .Range(Chr(64 + x) & "7:" & Chr(64 + x) & iRow).Interior.Color = _
                IIf(.Range(Chr(64 + x + 1) & 7).Interior.Color = RGB(215, 215, 215), RGB(195, 195, 195), RGB(215, 215, 215))
            .Range(Chr(64 + x) & "6:" & Chr(64 + x) & iRow).Borders(xlEdgeLeft).LineStyle = xlContinuous
        Next
        .Columns.AutoFit
        .Columns.HorizontalAlignment = xlHAlignCenter
        .[A6:B6].Interior.Color = RGB(215, 215, 215)
        iCol = .Cells(6, Columns.Count).End(xlToLeft).Column
        .Range("C6").Resize(1, iCol - 2).Interior.Color = RGB(255, 190, 0)
        For x = 1 To 4
            .Range(Choose(x, "A6:", "C6:", "A7:", "C7:") & Choose(x, "B6", Chr(64 + iCol) & "6", "B" & iRow, Chr(64 + iCol) & iRow)).BorderAround LineStyle:=xlContinuous
        Next
        .Activate
        .Range("A1:" & Chr(64 + iCol) & 1).Select
        ActiveWindow.Zoom = True
        .[A1].Select
    End With

A+