XL 2010 Filtre VBA

team18fr

XLDnaute Occasionnel
Bonjour,
Dans mon classeur j'ai deux feuilles une "saisie" et "PDF" dans la première j'ai toutes mes données que j'extrais dans "PDF" suivant certain critère.
Je voudrais rajouter a mon code la possibilité de voir si en colonne C de "saisie" si il y a un filtre et de l'appliquer dans la colonne C de PDF.
Ou plus simplement ne chercher que dans les cellules qui sont filtrées. Car pour l'instant malgrés un filtre sur la "saisie" cela extrait comme si je n'avais pas mis de filtre.
VB:
Sub Extraction2()
Dim lig%, k%
With Feuil4 'ici Feuil1 est sheets("PDF")
.[A4:AS10000].Clear
'Range("A1:AQ3").Copy: .Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
k = 5
For lig = 4 To Range("A1048576").End(3).Row
If Application.CountA(Range("A" & lig & ":F" & lig)) > 0 Then
If Cells(lig, 39) = "A meuler" Or Cells(lig, 43) = "RESTE LA FINITION" Or Cells(lig, 37) = "" Then
Range("A" & lig & ":AQ" & lig).Copy: .Cells(k, 1).PasteSpecial
k = k + 1
End If
End If
Next
.Columns("k:AJ").Hidden = True
chemin = ThisWorkbook.Path & "\Extractions\
'If Dir(ThisWorkbook.Path & "\Extractions\", vbDirectory) = "" Then
'MkDir (ThisWorkbook.Path & "\Extractions\")
'End If
'If Dir(chemin, vbDirectory) = "" Then
'MkDir (chemin)
'End If
Fichier = "SA à meuler sur" & " " & ActiveSheet.Name & " " & "au" & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date)
On Error Resume Next
Feuil4.ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & Fichier & ".pdf"
If Err = 0 Then
MsgBox Fichier & ".Pdf  a été créé"
Else
MsgBox "Impossible de créer le fichier PDF", vbExclamation, "ANNULATION"
End If

End With
End Sub
 

team18fr

XLDnaute Occasionnel
J'ai réussi à faire ce que je voulais mais je ne pense pas que se sois le plus simple et le plus propre.
Si vous avez des conseils pour améliorer je suis preneur.
VB:
Sub Extraction2()
Dim lig%, k%
Dim secteur As String
secteur = Cells(2, 3)
With Feuil3 'ici Feuil1 est sheets("PDF")
.[A4:AS10000].Clear
'Range("A1:AQ3").Copy: .Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
k = 4
For lig = 3 To Range("A1048576").End(3).Row
If Application.CountA(Range("A" & lig & ":F" & lig)) > 0 Then
If Cells(lig, 39) = "A meuler" Or Cells(lig, 43) = "RESTE LA FINITION" Or Cells(lig, 37) = "" Then
Range("A" & lig & ":AQ" & lig).Copy: .Cells(k, 1).PasteSpecial
k = k + 1
End If
End If
Next
Feuil3.Range("A3").AutoFilter Field:=3, Criteria1:=secteur
.Columns("k:AJ").Hidden = True
chemin = "ThisWorkbook.Path & "\Extractions\"
If Dir(chemin, vbDirectory) = ""
Then'MkDir (chemin)
End If
Fichier = "SA à meuler sur" & " " & secteur & " " & "au" & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date)
On Error Resume Next
Feuil3.ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & Fichier & ".pdf"
If Err = 0 Then
MsgBox Fichier & ".Pdf  a été créé"
Else
MsgBox "Impossible de créer le fichier PDF", vbExclamation, "ANNULATION"
End If
End With
End Sub
 

Discussions similaires

Réponses
1
Affichages
269
Compte Supprimé 979
C

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof