Copier des lignes d'une feuille1 à une feuille2 selon des conditions

Bonjour Tout le monde,

J'espère que vous allez bien.

J'ai un petit soucie à trouver un code adéquat pour le cas que j'ai.

En fait j'ai un fichier volumineu qui comporte plusieurs lignes, donc les lignes que je souhaite copier de la la feuille 1 à la feuille 2, c'est la ligne qui comporte la lettre X au niveau de la colonne numéro 16. Jai réussi à faire se code là .

Par contre, ce que je n'ai pas réussi à faire, c'est que lorsque ma boucle trouve la colonne comportant la lettre X, il faut que cette ligne soit copié de la feuille 1 vers la feuille 2 , ainsi que les le 3 lignes qui se trouve avant la ligne comportant la lettre X.

J'espère que mon besoin et assez clair.

D'avance, merci pour votre retour

Voici le code que j'ai utilisé.

Option Explicit

Dim tablo, TabloDP(), i&, j&, kDP&

Sub Séparer()

tablo = Range("A1:P" & Range("A" & Rows.Count).End(xlUp).Row)

kDP = 1

For i = 1 To UBound(tablo, 1)

If tablo(i, 16) = "X" Then

ReDim Preserve TabloDP(1 To 16, 1 To kDP + 1)

For j = 1 To 16

TabloDP(j, kDP) = tablo(i, j)

Next j

kDP = kDP + 1

End If

Next i

Sheets("X").Range("A1").CurrentRegion.Offset(1, 0).ClearContents

Sheets("X").Range("A2").Resize(UBound(TabloDP, 2), 16) = Application.Transpose(TabloDP)

MsgBox "Travail terminé."

End Sub

Bonjour et

cela permettrait de tester une solution filtre avancé ou mettre au point ta macro

Bonjour,

Merci beaucoup pour votre accueille

Ci joint mon fichier.

Merci beaucoup.

Je viens de rentrer ... je regarde demain.

AZIAFKH a écrit :

En fait j'ai un fichier volumineu qui comporte plusieurs lignes, donc les lignes que je souhaite copier de la la feuille 1 à la feuille 2, c'est la ligne qui comporte la lettre X au niveau de la colonne numéro 16. Jai réussi à faire se code là .

Il manque quand même la dernière !

SVP, c'est laquelle qui vous manque exactement?

Option Explicit

Dim tablo, TabloDP(), i&, j&, kDP&

Sub Séparer()
    tablo = Range("A1").CurrentRegion 'Delimitation du tableau'
    kDP = 1
    For i = 1 To UBound(tablo, 1)
        If tablo(i, 16) = "X" Or _
            tablo(Application.Min(UBound(tablo, 1), i + 1), 16) = "X" Or _
            tablo(Application.Min(UBound(tablo, 1), i + 2), 16) = "X" Or _
            tablo(Application.Min(UBound(tablo, 1), i + 3), 16) = "X" Then
            ReDim Preserve TabloDP(1 To 16, 1 To kDP + 1)
            For j = 1 To 16
                TabloDP(j, kDP) = tablo(i, j)
            Next j
            kDP = kDP + 1
        End If
    Next i
    Sheets("X").Range("A1").CurrentRegion.Offset(1, 0).ClearContents 'Si on modifie le fichier d base, la MAJ sera pris en compte après click sur le bouton'
    Sheets("X").Range("A2").Resize(UBound(TabloDP, 2), 16) = Application.Transpose(TabloDP) 'Permet de prendre en compte la tail actuel dutableau de le cas d'un suppression d'une ligne
    MsgBox "Travail terminé."
End Sub

AZIAFKH a écrit :

SVP, c'est laquelle qui vous manque exactement?

Celle de la ligne 28 ... j'ai donc transformé le début en

tablo = Range("A1").CurrentRegion

ou alors

tablo = Range("A1:P" & Range("P" & Rows.Count).End(xlUp).Row)

Cela fonctionne très très bien Merci infiniment pour votre aide.

Svp j'aimerais bien vérifier si j'ai bien compris le code ci dessous :

tablo(Application.Min(UBound(tablo, 1), i + 1), 16) = "X" Or _ // permet de copier la ligne qui se trouve à la position n-1 de la ligne comporte le caractère X au niveau de la colonne 16

tablo(Application.Min(UBound(tablo, 1), i + 2), 16) = "X" Or _ // permet de copier la ligne qui se trouve à la position n-2 de la ligne comporte le caractère X au niveau de la colonne 16

tablo(Application.Min(UBound(tablo, 1), i + 3), 16) = "X" // permet de copier la ligne qui se trouve à la position n-3 de la ligne comporte le caractère X au niveau de la colonne 16

C'est cela en effet, sans quand on arrive à la fin du tableau. C'est pour cela que j'ai introduit aussi Application.Min(UBound(tablo, 1), i + x)

D'accord j'ai compris.

Merci encore une fois, et très bonne journée à vous !!