VBA Copier Cellules en fonction d'une valeur et coller incrémentiel

Hello à tous,

Pour chaque ligne qui contient la valeur "test" en colonne "L" ,

je veux copier les valeurs en "B" "E" et "G" et les coller cote a cote dans la feuille "NAV" les unes en dessous des autres.

Voir fichier ci joint.

Merci à celui qui me trouvera une solution

Bonne journée

Nico

Bonjour,

Une piste :

Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim Tbl() As String
    Dim I As Integer

    With Worksheets("CRM"): Set Plage = .Range(.Cells(1, 12), .Cells(.Rows.Count, 12).End(xlUp)): End With

    For Each Cel In Plage

        If Cel.Value = "test" Then

            I = I + 1: ReDim Preserve Tbl(1 To 3, 1 To I)
            Tbl(1, I) = Cel.Offset(, -10).Value
            Tbl(2, I) = Cel.Offset(, -7).Value
            Tbl(3, I) = Cel.Offset(, -5).Value

        End If

    Next Cel

    With Worksheets("NAV"): .Range(.Cells(1, 1), .Cells(UBound(Tbl, 2), UBound(Tbl, 1))).Value = Tbl(): End With

End Sub

Hello Theze,

J'ai essayé mais j'ai un message d'erreur avec ton code :

sur cette ligne

): .Range(.Cells(1, 1), .Cells(UBound(Tbl, 2), UBound(Tbl, 1))).Value = Tbl():

Erreur d'execution 9

L'indice est en dehors des dimensions du tableau.

Une idée ?

J'ai compris d'ou venait l'erreur par contre j'ai oublié de spécifié que je voulais que l'ordre soit respecter ( dans ton code ca copie bien mais les lignes deviennent des colonnes dans l'onglet NAV)

Je voudrais également adapter le code pour pouvoir ajouter des données vers le bas car mon fichier est amené a évoluer et je vais rajouter des lignes ...

Merci encore

Re,

OK, alors voilà la solution :

Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim Tbl() As String
    Dim I As Integer

    With Worksheets("CRM"): Set Plage = .Range(.Cells(1, 12), .Cells(.Rows.Count, 12).End(xlUp)): End With

    For Each Cel In Plage

        If Cel.Value = "test" Then

            I = I + 1: ReDim Preserve Tbl(1 To 3, 1 To I)
            Tbl(1, I) = Cel.Offset(, -10).Value
            Tbl(2, I) = Cel.Offset(, -7).Value
            Tbl(3, I) = Cel.Offset(, -5).Value

        End If

    Next Cel

    With Worksheets("NAV"): .Range(.Cells(1, 1), .Cells(UBound(Tbl, 2), UBound(Tbl, 1))).Value = Application.Transpose(Tbl()): End With

End Sub

Merci 100 fois c'est nickel

Derniere opetite question comment faire si je veux que le tableau dans l'onglet NAV démarre à la ligne 2 ?

J'ai modifier la derniere ligne comme suit mais ca compromet le code. :

With Worksheets("NAV"): .Range(.Cells(2, 1), .Cells(UBound(Tbl, 2), UBound(Tbl, 1))).Value = Application.Transpose(Tbl()): End With

Merci encore

Re,

il te faut décaler les lignes (premier argument de l'objet Cells :

With Worksheets("NAV"): .Range(.Cells(2, 1), .Cells(UBound(Tbl, 2) + 1, UBound(Tbl, 1))).Value = Application.Transpose(Tbl()): End With

parfait merci

j'avait reussi en faisant la meme chose plus haut :

I = I + 1: ReDim Preserve Tbl(1 To 10, 1 To I + 1)

Mais je vais suivre ta facon qui m'evitera certainement de mauvaise surprises.

Encore merci pour tout ca marche nickel