Compter ligne avec un filtre + copier dans une feuille

Bonjour à toutes et à tous,

Je m'adresse à vous concernant un problème pour compter des lignes en utilisant un filtre et par la suite copier ma sélection.

Le processus :

- Dans le fichier "Exemple", vous trouverez 2 feuilles. Dans la feuille "Planning 2020", se trouve un tableau comportant sur la ligne 7, des filtres. Dans mon cas, les seuls filtres que j'utilise sont ceux de la semaine 1,2,3 soit S01(Colonne M), S02(Colonne O) et S03(Colonne Q).

- Si je commence par S01, je vais sur le filtre et je décoche la case "Vide" pour n'avoir que ce qui m'intéresse.

- Une fois filtré, j'ai les infos qu'il me faut. Ce sont celles que je veux copier. (Voir photo "1", le cadre rouge que j'ai fait) :

1

- Une fois ma sélection effectuée, j'aimerais juste la copier pour et la mettre dans la "feuil2" en Range("A1").

PROBLEME : Dans le titre j'ai inscris "compter lignes...". En effet, je pensais qu'en utilisant une boucle For comme à mes habitudes j'arriverais a me débrouiller sauf que....le filtre me bloque(puisque que dans ma boucle For , celui-ci compte toutes les lignes mêmes celles masquées par le filtres or je ne veux que les lignes filtrées). Voici mon début de code quand j'appuie sur le bouton "MIF" en haut de la feuille "Planning 2020" :

Private Sub Bt_MIF_Click()
Dim dLig As Long, Lig As Long

' Désactiver le rafraichissement écran
Application.ScreenUpdating = False

' Activer ce classeur
 ThisWorkbook.Activate ' Pas obligatoire

' Sur la feuille planning 2020
With ThisWorkbook.Sheets(1)
    .Activate
'Met un filtre
ActiveSheet.Range("$D$7:$DL$117").AutoFilter Field:=10, Criteria1:="<>"

' Trouver la dernière ligne remplie
dLig = .Range("F" & Rows.Count).End(xlUp).Row
For Lig = 7 To dLig

Next Lig

End With
End Sub

REMARQUE :

Evidemment, cela s'applique à la semaine 1 (S01), mais j'aimerais que le code soit adaptable et puisse se modeler par exemple pour la S02.

Ceci dit, la transition pour passer de S01 à S02 puis à S03 je pense pouvoir me débrouiller.

En vous souhaitant par avance, merci !

Bien cordialement,

8exemple.xlsm (31.29 Ko)

Bonsoir MPETIT, le forum,

A tester....

Sub copieLignesFiltrées()
 Dim dl1 As Long, dl2 As Long

  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

   With Sheets("Feuil2")
    .Cells.Delete
    dl2 = .Range("A" & Rows.Count).End(xlUp).Row + 1
   End With

   With Sheets("Planning  2020")
    dl1 = .Range("C" & Rows.Count).End(xlUp).Row
    '.Range("C7:Q" & dl1).AutoFilter Field:=10, Criteria1:="TRIM"   'j'ai fait le test en filtrant manuellement
    .Range("C4:Q" & dl1).SpecialCells(xlVisible).Copy Sheets("Feuil2").Range("A" & dl2)
     If .FilterMode = True Then .ShowAllData
   End With

  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub
10exemple.xlsm (34.63 Ko)

Cordialement,

Bonjour xorsankusai,

J'ai trifouillé ton code ce matin pour l'adapter à mon véritable fichier (tu imagines bien que le fichier que je t'ai partagé n'était qu'un petit exemple pour comprendre le principe.)

Néanmoins j'aimerais que tu m'aides encore un peu sur un détail qui me bloque et plus particulièrement :

.Range("C8:F" & dl1).SpecialCells(xlVisible).Copy Sheets("Feuil2").Range("A" & dl2)

En effet, cette ligne permet de copier les valeurs de C8 à F jusqu'à la dernière ligne visible, puis les coller dans la feuille 2.

Revenons sur ma photo 1 :

image

Contexte :

À droite, juste en dessous de "S01" (qui je le rappelle, sert à désigner la semaine ), il y a "TRIM", "MEN+B" et "SEM". J'aimerais copier ces valeurs et les coller dans la feuille 2. Assez simple puisque je peux ré-utiliser ton code en le modifiant :

.Range("L8:L" & dl1).SpecialCells(xlVisible).Copy Sheets("Feuil2").Range("G" & dl2)

Problème :

Là je n'applique ca que pour la semaine 1, donc ".Range("L8:L" & dl1)" fonctionne puisque la plage n'évolue pas !

Maintenant si je fait le même processus mais pour S02 et bien... ca ne fonctionne pas puisque la plage "L8:L" s'est décaler de 2 colonnes !

J'ai modifié ton code comme ceci : (mais je n'arrive pas à savoir comment récupérer la plage que je viens te parler)

Sub copieLignesFiltrées()
Dim dl1 As Long, dl2 As Long
Dim memoire As Integer

'Cette variable permet de choisir son filtre
memoire = 10

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Je trouve la dernière colonne
dCol = Sheets("Planning  2020").Cells(7, Columns.Count).End(xlToLeft).Column

'Je commence à la colonne S01, soit la colonne L, soit L=12
For Col = 12 To dCol

    With Sheets("Feuil2")
        .Cells.Delete
        'On détermine la dernière ligne de la feuille "Feuil2"
        dl2 = .Range("A" & Rows.Count).End(xlUp).Row + 1
    End With

    With Sheets("Planning  2020")
        'On détermine la dernière ligne de la feuille "Planning 2020"
        dl1 = .Range("C" & Rows.Count).End(xlUp).Row
        'On active le filtre
        .Range("C7:Q" & dl1).AutoFilter Field:=memoire, Criteria1:="<>" 
        'On copie les lignes souhaitées
        .Range("C4:Q" & dl1).SpecialCells(xlVisible).Copy Sheets("Feuil2").Range("A" & dl2)

        'C'est cette ligne qui me bloque : comment la plage "L8:L" peut s'incrémenter de 2 colonnes à  chaque fois
        .Range("L8:L" & dl1).SpecialCells(xlVisible).Copy Sheets("Feuil2").Range("G" & dl2)

        If .FilterMode = True Then .ShowAllData
    End With

memoire = memoire + 2

Next Col
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Concrètement, comment faire pour que ton code fonctionne en ne faisant pas que la S01 mais la S02, S03 etc ?

J'espère avoir été assez compréhensible.

@+

Bonjour MPETIT, le forum,

J'espère avoir été assez compréhensible.

Pas sûr d'avoir compris.....


Est-ce le résultat souhaité ?

capture

Si oui, à tester.....

Sub CopieSemainePlanning()
 Dim dl1 As Long, dc As Integer, j As Integer

  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

   With Sheets("Feuil2")
    .Cells.Delete
    .Rows("1:1").Font.Bold = True
   End With

   With Sheets("Planning  2020")
    dl1 = .Range("C" & Rows.Count).End(xlUp).Row
     dc = Cells(7, Cells.Columns.Count).End(xlToLeft).Column
           j = 1
       For i = 12 To dc Step 2
        .Range("C7:Q" & dl1).AutoFilter Field:=i - 2, Criteria1:="<>"
        .Range(Cells(7, i), Cells(dl1, i)).SpecialCells(xlVisible).Copy
        Sheets("Feuil2").Cells(1, j).PasteSpecial Paste:=xlPasteValues
         If .FilterMode = True Then .ShowAllData
          j = j + 1
       Next i
   End With
   Sheets("Feuil2").Activate
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub
1exemplev2.xlsm (32.64 Ko)

Cordialement,

Bonjour xorsankusai, le forum,

Désolé pour la mauvaise explication. J'ai essayé d'être le plus clair possible mais ce n'est pas simple.

Dans tous les cas, tu as su répondre à mon attente et j'ai trouvé la solution qui m'intéressait grâce à ton code.

Merci bien

En te souhaitant une bonne de journée,

@+

Rechercher des sujets similaires à "compter ligne filtre copier feuille"