Copier cellule suivant un critère VBA

Bonjour à tous,

je viens vers vous pour avoir un peu d'aide sur le sujet. Je souhaite réaliser une macro me permettant de copier des données suivant un critère.

Je vous joins mon fichier pour d'avantages explications.

Bonne journée.

Cordialement.

Baptiste

23classeur1.xls (16.50 Ko)

Bonjour,

Une solution avec recherche du critère dans la feuille 2, ce qui te permettra d'ajouter des colonnes.

A+

43classeur1.zip (16.78 Ko)

Bonjour,

merci pour votre réponse le principe de la macro est celui attendu. Toutefois lorsque le nombre de lignes entre les deux colonnes (Critère delta et Bravo) ne sont pas identiques celui relève date de fin et valeur de la colonne A et B respectivement.

Voyez-vous une amélioration à effectuer?

Merci par avance,

Cordialement.

Baptiste

Re,

Effectivement, j'avais placé un C.Row en lieu et place de C.Column.

Essaie comme cela.

Sub Test()
Dim CelAjout As Range, C As Range
Dim Critere As String
Dim DerLig As Long
    With Worksheets("Feuil1")
        Set CelAjout = .Range("B7")
        Critere = .Range("$B$5")
        CelAjout.Resize(2, 2).ClearContents
    End With
    With Worksheets("Feuil2")
        Set C = .Rows(1).Find(Critere, LookIn:=xlValues, lookat:=xlWhole)
        If Not C Is Nothing Then
            DerLig = .Cells(Rows.Count, C.Column).End(xlUp).Row
            CelAjout.Value = .Cells(2, C.Column - 1).Value 'Date début
            CelAjout.Offset(1, 0).Value = .Cells(2, C.Column).Value  'Valeur début
            CelAjout.Offset(0, 1).Value = .Cells(DerLig, C.Column - 1).Value  'Date fin
            CelAjout.Offset(1, 1).Value = .Cells(DerLig, C.Column).Value  'Valeur fin
        End If
    End With
End Sub

A+

Bonsoir Frangy,

je te remercie pour l'aide que tu m'a consacré, c'est nickel, ça fonctionne parfaitement.

Merci encore, bonne soirée.

Cordialement.

Baptiste

Rechercher des sujets similaires à "copier suivant critere vba"