Sub TransfertY()
Dim WshSrc As Worksheet, WshCbl As Worksheet, Rng As Range
Set WshSrc = ActiveSheet
Set WshCbl = ThisWorkbook.Worksheets(WshSrc.Name & " Exclusion")
WshCbl.[2:10000].Delete
Set Rng = ColLignesOùRelat(WshSrc.[A2:H2], "I", "<>", "")
If Not Rng Is Nothing Then Rng.Copy Destination:=WshCbl.[A2]
WshCbl.Columns.AutoFit
Application.PrintCommunication = False
With WshCbl.PageSetup
.PrintArea = WshCbl.UsedRange.Address
.PrintTitleRows = "$1:$1"
.Orientation = xlLandscape
.FitToPagesWide = 1
.FitToPagesTall = False
End With
Application.PrintCommunication = True
WshCbl.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "\Visa exclusion " & WshSrc.Name & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub