IF ELSE // En fonction d'une sélection de ligne Visible

Bonjour,

Je viens sur ce forum pour la première fois car je n'arrive pas à trouver de solution à mon problème après de diverse recherche.

Je commence dans le traitement VBA avec mon travail et avec le code ci dessous j'ai pour tâche de transférer des fichiers défini grâce à un critère de mon tableau à la dernière ligne d'un tableau déjà existant, mais utilisant un IF/ELSE car il se peut que dans mon tableau le critère recherché ne soit pas présent dans ce cas un message s'affichera indiquant qu'aucun dossier ne sois présent.

Mais, lorsque je lance ma macro mon problème est que si dans la ligne 2 de base je n'ai pas de demande suivant mon critère alors le message de mon ELSE s'affichera même si j'ai des demande suivant ma critère dans mon tableau

Dans ce cas, automatiquement j'ai l'obligation de devoir avoir une demande dans ma ligne 2 or ce que je voudrais, c'est que tout mes lignes visible suite à mon critère soit envoyé dans l'autre tableau et que si, aucun des dossiers suivant mon critère ne soit affiché alors le message s'affiche.

Voici mon code pour le moment:

Sub macrotransfertfichierclos()'
' macrotransfertfichierclos Macro
'

'
    Sheets("FichierTraitement").Select
    ActiveSheet.ListObjects("Tableau22").Range.AutoFilter Field:=11, Criteria1 _
        :="CLOS"
    derniereLigne = Cells(Rows.Count, 1).End(xlUp).Row

    If Rows(2).Hidden = False Then
        Range("A2", Cells(derniereLigne, 14)).SpecialCells(xlCellTypeVisible).Copy

        Sheets("FichierClos").Select
        derniereLigne = Cells(Rows.Count, 1).End(xlUp).Row
        ' Range("A" & derniereLigne + 1).Select
        ActiveSheet.Paste Destination:=Worksheets("FichierClos").Range("A" & derniereLigne + 1)

        ActiveSheet.ListObjects("Tableau22").Range.AutoFilter Field:=11
    Else
            MsgBox ("Pas de fichier clos")
         ActiveSheet.ListObjects("Tableau22").Range.AutoFilter Field:=11

    End If
End Sub

J'ai essayé de modifier mon code en sélectionnant les fichiers visibles avant d'entre dans mon IF mais je ne sais pas quoi remplacer à la place de mon IF rows(2).Hidden

 Sheets("FichierTraitement").Select
    ActiveSheet.ListObjects("Tableau22").Range.AutoFilter Field:=11, Criteria1 _
        :="CLOS"
    derniereLigne = Cells(Rows.Count, 1).End(xlUp).Row

    Selection.SpecialCells(xlCellTypeVisible).Select

    If Rows(2).Hidden = False Then

Auriez-vous une petite idée ou une petite aide à me donner je vous en serais fortement reconnaissant.

Bonjour

Avec le fichier ce serait plus facile. En précisant quel critère, dans quelle colonnes.

Cordialement

Mon fichier est trop lourd pour être envoyé, mais cela est pour le critères AVP de la colonne K

Bonjour Valroma,

Avec le fichier ce serait mieux effectivement, mais vous pouvez essayer quand même ceci (pas testé)

Sub macrotransfertfichierclos()'
  Dim ShtT as WorkSheet, ShtC as WorkSheet
  Dim dLig as long, Lig as long, nLig as Long
  ' macrotransfertfichierclos Macro

  Set ShtT = Sheets("FichierTraitement")
  ShtT.ListObjects("Tableau22").Range.AutoFilter Field:=11, Criteria1:="CLOS"
  dlig = ShtT.Cells(Rows.Count, 1).End(xlUp).Row
  ' Pour chaque ligne
  For Lig = 2 to dLig
    If ShtT.ListObjects("Tableau22").Rows(lig).Hidden = true Then
      ' Nouvelle ligne dans le classeur clos
      nLig = Sheets("FichierClos").Cells(Rows.Count, 1).End(xlUp).Row +1
      ' Copie des lignes dans le classeur
      ShtT.Range("A" & lig, ShtT.Cells(dLig, 14)).SpecialCells(xlCellTypeVisible).Copy _
          Destination:=Worksheets("FichierClos").Range("A" & nlig)
      ShtT.ListObjects("Tableau22").Range.AutoFilter Field:=11
     Exit For
    Else
      MsgBox ("Pas de fichier clos")
      ActiveSheet.ListObjects("Tableau22").Range.AutoFilter Field:=11
    End If
  Next Lig
  Set ShtT = Nothing
End Sub

@+

Je vous remercie pour votre aide, j'ai étais testé votre code mais il m'indique une erreur similaire a celle que j'ai eu lors de mes test,

" Erreur d'exécution '438' Propriété ou méthode non gérée par cet objet"

et cela a la même ligne qui posait problème toujours ce bon vieux IF

Re,

Je ne vois aucune de mes lignes colorées en jaune !?

Sur quelle ligne se situe t'elle ?

@+

Bonsoir,

Essayer ce code :

Sub macrotransfertfichierclos()    
    Dim plage_filtrée As Range, destination As Range

    Sheets("FichierTraitement").Select
    With ActiveSheet.ListObjects("Tableau22")
        .Range.AutoFilter Field:=11, Criteria1:="CLOS"

        On Error Resume Next
        Set plage_filtrée = .DataBodyRange.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        If Not plage_filtrée Is Nothing Then
            plage_filtrée.Copy
            Set destination = Sheets("FichierClos").Columns("A").Find("")
            ActiveSheet.Paste destination:=destination
            Application.CutCopyMode = False
        Else
            MsgBox ("Pas de fichier clos")
            .Range.AutoFilter Field:=11
        End If

    End With

End sub

Merci beaucoup

Je viens de tester votre code, il fonctionne parfaitement, je n'avais pas pensé de plage_filtrée

Bonne journée à vous