(VBA) DerColS 1 case sur 3

Bonjour,

Tout est dans le titre.. Un gars m'a vachement bien aidé pour trouver le code ci - dessous.

Il rappatrie les infos d'une Feuil1 vers la Feuil2 sa marche très bien.

Sauf que !!

Il faudrait que je l'adapte quelque peut:

1) Les informations à extraire sont sur la même ligne mais 1 case sur 3 depuis la colonne 5.

2) Dès la première case vide rencontré il faudrait arrêter l'import de données. J'ai un total en bout de ligne que je ne veux pas importer.

Je ne joins pas de fichier car je pense que c'est juste quelques instructions que je ne connais pas donc peut importe un fichier exemple.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Range
Dim LigC As Long
Dim ColS As Integer, DerColS As Integer
    If Target.Count > 1 Then Exit Sub
    If Target.Address = "$D$5" Then
        Range("A8", Range("A8").End(xlDown)).Clear
        LigC = 8
        With Worksheets("RECAP.")
            Set C = .Columns(3).Find(Target.Value, , xlValues, xlWhole)
            If Not C Is Nothing Then
                DerColS = .Cells(C.Row, Columns.Count).End(xlToLeft).Column
                If DerColS > 1 Then
                    For ColS = 5 To DerColS
                        Cells(LigC, 1) = .Cells(C.Row, ColS).Value
                        LigC = LigC + 1
                    Next ColS
                End If
            End If
        End With
    End If
End Sub

Mercid e vôtre aide !!

bonjour,

essaie en remplaçant

 For ColS = 5 To DerColS

par

 For ColS = 5 To DerColS step 3

h2so4 a écrit :

bonjour,

essaie en remplaçant

 For ColS = 5 To DerColS

par

 For ColS = 5 To DerColS step 3

Salut !!

Sa marche nickel il ne reste plus qu'à trouver comment ne pas inclure ma dernière colonne (AF).

Merci pour ta rapidité !! =)

bonjour

pour la dernière colonne

essaie en remplaçant

Cells(LigC, 1) = .Cells(C.Row, ColS).Value

par

if .cells(c.rows,cols)="" then exit for
Cells(LigC, 1) = .Cells(C.Row, ColS).Value

Sa ne marche pas :/

Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Range
Dim LigC As Long
Dim ColS As Integer, DerColS As Integer
    If Target.Count > 1 Then Exit Sub
    If Target.Address = "$E$5" Then
        Range("B8", Range("B8").End(xlDown)).Clear
        LigC = 8
        With Worksheets("RECAP.")
            Set C = .Columns(3).Find(Target.Value, , xlValues, xlWhole)
            If Not C Is Nothing Then
                DerColS = .Cells(C.Row, Columns.Count).End(xlToLeft).Column
                If DerColS > 1 Then
                    For ColS = 5 To DerColS Step 3
                        If .Cells(C.Rows, ColS) = "" Then Exit For
                        Cells(LigC, 2) = .Cells(C.Row, ColS).Value
                        LigC = LigC + 1
                    Next ColS
                End If
            End If
        End With
    End If
End Sub

Est ce qu'il est possible de lui dire d'arrêter le rapatrimant de donnée à la colonne AH ?

Bonjour,

j'ai fait une faute de frappe, voici le code

if .cells(c.row,cols)="" then exit for
Cells(LigC, 1) = .Cells(C.Row, ColS).Value

Ah effectivement ça marche mieux =)

Merci beaucoup pour ton aide !!