XL 2010 Filtre VBA

team18fr

XLDnaute Junior
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 Junior
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

Haut Bas