Mettre des offset dans une boucle While

Bonjour à tous,

J’aurais besoin de votre aide pour l’utilisation des Offset dans les macros VBA.

Pour info, je suis sous Excel 2006.

Dans mon programme je fais une boucle While qui me permet d’appliquer un filtre sur une colonne puis de décaler ce filtre vers la prochaine colonne à filtrer.

Pour faire simple je dois filtrer la colonne A puis la colonne E puis la colonne I …

Cela j’y arrive très bien.

A chaque fois que je mets un filtre sur une colonne, je dois récupérer les infos dans colonne filtrée +1 et +3.

Par exemple, si je filtre la colonne A, je dois récupérer les infos de la colonne B et D puis copier les résultats dans une nouvelle feuille puis à la seconde itération de la boucle while, je filtre la colonne E et je dois récupérer les infos de la colonne F et G, …

Mon code actuel :

Private Sub Button_CableRecherche()

    'Empeche le scintillement de l'écran lors de changement des feuilles
    Application.ScreenUpdating = False

    Dim iNbrNouvellesLignes As Integer 'Nombre de lignes après avoir appliqué le filtre
    Dim iCompteLignes As Integer 'Utilisé pour rajouter les éléments filtrés à la suite de la Feuil2
    Dim iColonneFiltre As Integer 'Numéro de colonne pour l'AutoFilter

    iNbrNouvellesLignes = 0
    iCompteLignes = 0
    iColonneFiltre = 1 'Initialisé à deux car la première colonne est en colonne B soit numéro 2

    Sheets("Feuil2").Select
    Sheets("Feuil2").Range("B3:C100").Select
    Selection.ClearContents

    Sheets("Feuil1").Select

    Do While iColonneFiltre < 21 'Balaye toutes les colonnes
        'Supprime les éventuels filtres
        On Error Resume Next
        Sheets("Feuil1").ShowAllData

        'Applique un filtre sur les colonnes CABLE
        Sheets("Feuil1").Range("A2:T2").AutoFilter Field:=iColonneFiltre, Criteria1:=Array("DROIT"), Operator:=xlFilterValues
        'Compte les lignes de la plage filtrée
        iNbrNouvellesLignes = Sheets("Feuil1").AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1

        If iNbrNouvellesLignes > 0 Then
            'Récupère la plage filtrée
            Sheets("Feuil1").Range("B3:B" & Range("A65536").End(xlUp).Row + 1).SpecialCells(xlCellTypeVisible).Copy Sheets("Feuil2").Range("B" & iCompteLignes + 3)
            Sheets("Feuil1").Range("D3:D" & Range("A65536").End(xlUp).Row + 1).SpecialCells(xlCellTypeVisible).Copy Sheets("Feuil2").Range("C" & iCompteLignes + 3)

            iCompteLignes = iCompteLignes + iNbrNouvellesLignes
        End If

       'J'augmente la variable de +4 car la prochaine colonne sur laquelle on doit appliquer le filtre se trouve à 4 colonnes de là où l'on se trouve
       iColonneFiltre = iColonneFiltre + 4
    Loop

    'Supprime les éventuels filtres
    On Error Resume Next
    Sheets("Feuil1").ShowAllData

    'Empeche le scintillement de l'écran lors de changement des feuilles
    Application.ScreenUpdating = True

End Sub

Dans le code je sais où le problème se trouve, c’est au niveau des lignes :

Sheets("Feuil1").Range("B3:B" & Range("A65536").End(xlUp).Row + 1).SpecialCells(xlCellTypeVisible).Copy Sheets("Feuil2").Range("B" & iCompteLignes + 3)

Sheets("Feuil1").Range("D3:D" & Range("A65536").End(xlUp).Row + 1).SpecialCells(xlCellTypeVisible).Copy Sheets("Feuil2").Range("C" & iCompteLignes + 3)

Je copie toujours les colonnes B et D. Il faudrait que je décale ces colonnes à chaque boucle while mais je ne sais pas comment y appliquer un offset.

Je mets en pièce jointe un fichier d’exemple

En vous remerciant d’avance,

Bonjour,

Un essai ...

Option Explicit

Private Sub Button_CableRecherche()
Dim iNbrNouvellesLignes As Integer    'Nombre de lignes après avoir appliqué le filtre
Dim iCompteLignes As Integer    'Utilisé pour rajouter les éléments filtrés à la suite de la Feuil2
Dim iColonneFiltre As Integer    'Numéro de colonne pour l'AutoFilter
Dim Dlig As Integer

    'Empeche le scintillement de l'écran lors de changement des feuilles
    Application.ScreenUpdating = False

    iNbrNouvellesLignes = 0
    iCompteLignes = 0
    iColonneFiltre = 1    'Initialisé à deux car la première colonne est en colonne B soit numéro 2

    Sheets("Feuil2").Range("B3:C100").ClearContents

    With Sheets("Feuil1")
        .Activate
        Do While iColonneFiltre < 21    'Balaye toutes les colonnes
    'Supprime les éventuels filtres
            On Error Resume Next
            .ShowAllData

    'Applique un filtre sur les colonnes CABLE
            .Range("A2:T2").AutoFilter Field:=iColonneFiltre, Criteria1:=Array("DROIT"), Operator:=xlFilterValues
    'Compte les lignes de la plage filtrée
            iNbrNouvellesLignes = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1

            If iNbrNouvellesLignes > 0 Then
                ' trouve la dernière ligne
                Dlig = .Cells(Rows.Count, iColonneFiltre + 1).End(xlUp).Row + 1

    'Récupère la plage filtrée
                .Range(.Cells(3, iColonneFiltre + 1), .Cells(Dlig, iColonneFiltre + 1)).SpecialCells(xlCellTypeVisible).Copy Sheets("Feuil2").Range("B" & iCompteLignes + 3)
                .Range(.Cells(3, iColonneFiltre + 3), .Cells(Dlig, iColonneFiltre + 3)).SpecialCells(xlCellTypeVisible).Copy Sheets("Feuil2").Range("C" & iCompteLignes + 3)
                iCompteLignes = iCompteLignes + iNbrNouvellesLignes
            End If

    'J'augmente la variable de +4 car la prochaine colonne sur laquelle on doit appliquer le filtre se trouve à 4 colonnes de là où l'on se trouve
            iColonneFiltre = iColonneFiltre + 4
        Loop

    'Supprime les éventuels filtres
        On Error Resume Next
        .ShowAllData
        On Error GoTo 0
    End With
    'Empeche le scintillement de l'écran lors de changement des feuilles
    Application.ScreenUpdating = True
End Sub

ric

Niquel, je viens de le porter sur mon fichier en production et cela fonctionne très bien.

J'aurais jamais trouvé tout seul.

Merci encore pour cette aide ric ;-)

ric