Macro

Bonjour à tous,

Je reviens aujourd'hui pour un autre problème de macro... décidemment ....

Je vous joints un fichier type avec toutes les explications à l'intérieur...

Tout est modulable, je peux ajouter des onglets des colonnes si besoin rien n'est figé.

Merci d'avance à tout ceux qui pourront se pencher sur mon cas

Christelle

Bonjour,

solution via une macro. La macro fait l'hypothèse que les devis portant le même numéro (mais avec version différente) se suivent.

Sub aargh()
    With Sheets("feuil1")
        k = 4 'position de la ligne titre
        ik = k
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        .Columns("G:I").Delete
        .Cells(k, 7).Resize(, 3).Value = .Cells(k, 1).Resize(, 3).Value
        mmax = 0
        dev = ""
        For i = k + 1 To dl + 1
            ndev = .Cells(i, 1)
            If InStr(ndev, "/") <> 0 Then ndev = Left(ndev, InStr(ndev, "/") - 1)
            If ndev <> dev Then
                If dev <> "" Then
                    k = k + 1
                    .Cells(k, 7).Resize(, 3).Value = .Cells(imax, 1).Resize(, 3).Value
                End If
                imax = i
                mmax = .Cells(i, 3)
                dev = ndev
            Else
                If .Cells(i, 3) > mmax Then
                    imax = i
                    mmax = .Cells(i, 3)
                End If
            End If
        Next i
        .Range("G" & ik & ":I" & k).Borders.Weight = xlThin
    End With
End Sub

terrible merci bcp

h2so4 sans abuser peux tu me dire où modifier la macro pour que le résultat se mette dans la feuille du même classeur nommée "données" en A1...

re-bonjour,

voici

Sub aargh()
    Set wsd = Sheets("données")
    ik = 4 'position ligne entête sur feuil1
    With Sheets("feuil1")
        k = 1    'position de la ligne titre sur feuilles données
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        wsd.Columns("A:C").Delete
        wsd.Cells(k, 1).Resize(, 3).Value = .Cells(ik, 1).Resize(, 3).Value
        mmax = 0
        dev = ""
        For i = ik + 1 To dl + 1
            ndev = .Cells(i, 1)
            If InStr(ndev, "/") <> 0 Then ndev = Left(ndev, InStr(ndev, "/") - 1)
            If ndev <> dev Then
                If dev <> "" Then
                    k = k + 1
                    wsd.Cells(k, 1).Resize(, 3).Value = .Cells(imax, 1).Resize(, 3).Value
                End If
                imax = i
                mmax = .Cells(i, 3)
                dev = ndev
            Else
                If .Cells(i, 3) > mmax Then
                    imax = i
                    mmax = .Cells(i, 3)
                End If
            End If
        Next i
        With wsd.Range("A1:C" & k)
        .Borders.Weight = xlThin
        .EntireColumn.AutoFit
        End With
    End With
End Sub

Parfait merci merci merci