[XL-2000] MACRO : copie de plusieurs feuilles sous conditions [Résolu]

[Killie]

J'ai une macro qui me permet de recopier les colonnes A à J de la feuille 1 sur la feuille 2 si la colonne K de la feuille 1 comporte un A ou un I.

La macro fonctionne mais... je voudrais appliquer cette macro pour d'autres feuilles c'est à dire copier les mêmes colonnes dans la feuille 3 si A et I se trouvent dans la colonne J.

etc, etc... (j'ai 5 feuilles dans ce fichier).

Je ne sais pas comment faire pour qu'une seule macro puisse me permettre cela...


J'espère avoir été assez claire...

Ci-joint ma macro :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Filtre()
 
  Dim Lig     As Long
  Dim Col     As String
  Dim NbrLig  As Long
  Dim NumLig  As Long
 
  Sheets("2").Activate
  Col = "K"
  NumLig = 1
  With Sheets("1")
  NbrLig = .Cells(65536, Col).End(xlUp).Row
  For Lig = 2 To NbrLig
    If .Cells(Lig, Col).Value = "A" Or .Cells(Lig, Col).Value = "I" Then
       .Range("A" & Lig & ":K" & Lig).Copy
    NumLig = NumLig + 1
    Cells(NumLig, 1).Select
    ActiveSheet.Paste
    End If
    Next
End With
 
End Sub

Merci beaucoup de votre aide.

[jfontaine]

Bonjour,

Ci dessous une adaptation de ton code en utilisant l'objet worksheet

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub Filtre()
 
Dim Lig As Long
Dim Col As String
 
Dim NumLig As Long
 
Dim Sh As Worksheet
Dim Shcible As Worksheet
 
Set Shcible = ThisWorkbook.Sheets("2")
 
Col = "K"
 
NumLig = 1
 
For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name <> Shcible.Name Then
        For Lig = 2 To Sh.Range("K" & Rows.Count).End(xlUp).Row
            If Sh.Range("K" & Lig).Value = "A" Or Sh.Range("K" & Lig).Value = "I" Then
                Sh.Range("A" & Lig & ":K" & Lig).Copy Shcible.Range("A" & NumLig)
                NumLig = NumLig + 1
            End If
        Next
    End If
Next Sh
 
End Sub

[Killie]

Je pense que je me suis mal expliquée parce que je copie les lignes :
dans la feuille 2 si j'ai A ou I colonne J (de la feuille1)
dans la feuille 3 si j'ai A ou I colonne K (de la feuille1)
dans la feuille 4 si j'ai A ou I colonne L (de la feuille 1)

Je n'ai pas trop l'habitude et je suis larguée...

Un grand merci pour votre aide.

[jfontaine]

A essayer

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub Filtre()
 
Dim Lig As Long
 
Dim Sh As Worksheet
Dim Shcible As Worksheet
 
For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name <> "1" Then
        For Lig = 2 To Sh.Range("K" & Rows.Count).End(xlUp).Row
            If Sh.Range("K" & Lig).Value = "A" Or Sh.Range("K" & Lig).Value = "I" Then
                Set Shcible = ThisWorkbook.Sheets("2")
                Sh.Rows(Lig).Copy Shcible.Range("A" & Shcible.Range("A" & Rows.Count).End(xlUp).Row + 1)
            End If
            If Sh.Range("J" & Lig).Value = "A" Or Sh.Range("J" & Lig).Value = "I" Then
                Set Shcible = ThisWorkbook.Sheets("1")
                Sh.Rows(Lig).Copy Shcible.Range("A" & Shcible.Range("A" & Rows.Count).End(xlUp).Row + 1)
            End If
            If Sh.Range("L" & Lig).Value = "A" Or Sh.Range("L   " & Lig).Value = "I" Then
                Set Shcible = ThisWorkbook.Sheets("4")
                Sh.Rows(Lig).Copy Shcible.Range("A" & Shcible.Range("A" & Rows.Count).End(xlUp).Row + 1)
            End If
        Next
    End If
Next Sh
 
End Sub

[Killie]

Une erreur s'affiche :

erreur d'exécution '9' - indice en dehors de la plage


C'est dommage....

Mais merci quand même !

[gFZT82]

Bonjour,

Si j’ai bien compris,
si la colonne J de la feuille "1" contient « A » ou « I », on copie la ligne correspondante dans la feuille "2"
si la colonne K de la feuille "1" contient « A » ou « I », on copie la ligne correspondante dans la feuille "3"
si la colonne L de la feuille "1" contient « A » ou « I », on copie la ligne correspondante dans la feuille "4"

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Option Explicit
Sub Filtre()
Dim ShSource As Worksheet
Dim ShCible As Worksheet
Dim LigSource As Long, LigCible As Long
Dim ColSource As Variant
Dim N°OrdreSh As Byte
 
    Set ShSource = ThisWorkbook.Worksheets("1")
    'Initialisation
    N°OrdreSh = 0
    'Pour chaque feuille cible
    For Each ShCible In ThisWorkbook.Worksheets(Array("2", "3", "4"))
        'On définit la colonne de référence correspondante dans la feuille source
        ColSource = Array("J", "K", "L")
        'On définit le numéro de la première ligne où s'effectue la copie dans la feuille cible
        LigCible = 2 ' la première ligne est réservée à l'en-tête
        'Pour chaque ligne de la feuille source
        For LigSource = 2 To ShSource.Cells(ShSource.Rows.Count, ColSource(N°OrdreSh)).End(xlUp).Row
            'Si la colonne de référence de la feuille source contient "A" ou "I"
            If ShSource.Cells(LigSource, ColSource(N°OrdreSh)).Value = "A" Or ShSource.Cells(LigSource, ColSource(N°OrdreSh)).Value = "I" Then
                'recopie la ligne correspondante de la feuille "1" vers la feuille cible
                ShSource.Rows(LigSource).Copy Destination:=ShCible.Range("A" & LigCible)
                'Incrémentation de la ligne cible
                LigCible = LigCible + 1
            End If
        Next LigSource
        'Incrémentation de la colonne de référence
        N°OrdreSh = N°OrdreSh + 1
    Next ShCible
End Sub

Cordialement.

[Killie]

Trop fort !

Franchement un grand merci et un énoooorme bravo, je suis scotchée !

Juste... je ne voudrais pas abuser.... mais si je peux ajouter une petite question...

Au lieu de copier la ligne entière je souhaiterais seulement copier les 5 premières colonnes (ABCDE), c'est possible ?

Merci Merci Merci !

[gFZT82]

Bonsoir,

c'est possible ! (ça me rappelle une pub) .

Tu remplaces

Code :

ShSource.Rows(LigSource).Copy Destination:=ShCible.Range("A" & LigCible)

par

Code :

ShSource.Range(ShSource.Cells(LigSource, "A"), ShSource.Cells(LigSource, "E")).Copy Destination:=ShCible.Range("A" & LigCible)

Cordialement.

[Killie]

Ça marche !

Bravo, vraiment, je suis admirative...

Sincèrement, mille mercis !