Sub TransfertY()
Dim WshSrc As Worksheet, LOt As ListObject, TD(), LD As Long, TR(), LR As Long, C As Long, DiffL As Long
Set WshSrc = ActiveSheet
Set LOt = WshExclPDF.ListObjects(1)
TD = ColUti(WshSrc.[A2:I2]).Value
ReDim TR(1 To UBound(TD, 1), 1 To 8)
For LD = 1 To UBound(TD, 1)
If Not IsEmpty(TD(LD, 9)) Then
LR = LR + 1
For C = 1 To 8: TR(LR, C) = TD(LD, C): Next C
End If: Next LD
If LR = 0 Then
MsgBox "Aucune coche mise" & vbLf & "==> pdf non créé.", vbCritical, "TransfertY"
LOt.DataBodyRange.ClearContents
Exit Sub: End If
DiffL = LR - LOt.ListRows.Count
If DiffL > 0 Then
WshExclPDF.Rows(2).Resize(DiffL).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
ElseIf DiffL < 0 Then
WshExclPDF.Rows(2).Resize(-DiffL).Delete
End If
LOt.DataBodyRange.Value = TR
Application.PrintCommunication = False
With WshCbl.PageSetup
.LeftHeader = WshSumm.[D2].Value
.CenterHeader = WshSrc.Name
.RightHeader = WshSumm.[D3].Value
.FitToPagesWide = 1
.FitToPagesTall = False
End With
Application.PrintCommunication = True
WshExclPDF.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "\Exclusion list " & WshSrc.Name & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub