Option Explicit
Sub Copier()
Dim TSrc(), TCbl(), LSrc As Long, LCbl As Long, C As Integer
TSrc = Feuil2.ListObjects("T_LIVRAISONS_Livraisons").DataBodyRange.Value
ReDim TCbl(1 To UBound(TSrc, 1), 1 To 8)
For LSrc = 1 To UBound(TSrc)
If TSrc(LSrc, 24) Like "COMMANDE*" Then
LCbl = LCbl + 1
For C = 1 To 7: TCbl(LCbl, C) = TSrc(LSrc, C): Next C
TCbl(LCbl, 8) = TSrc(LSrc, 24)
End If
Next LSrc
TableauRetaillé(Feuil13.ListObjects("Tableau16"), LCbl) = TCbl
End Sub
Property Let TableauRetaillé(ByVal LOt As ListObject, Optional ByVal LMax As Long, TVals())
Dim Trop As Long, CMax As Long, TFml(), F As Long
If LMax = 0 Then LMax = UBound(TVals, 1)
Trop = LOt.ListRows.Count - LMax
If Trop > 0 Then
LOt.ListRows(LMax + 1).Range.Resize(Trop).Delete xlShiftUp
ElseIf Trop < 0 And LMax + Trop > 1 Then
LOt.ListRows(LMax + Trop).Range.Resize(-Trop).Insert xlShiftDown, xlFormatFromLeftOrAbove
End If
If LMax = 0 Then Exit Property
ReDim TFml(1 To LOt.ListColumns.Count)
For F = 1 To UBound(TFml)
With LOt.HeaderRowRange(2, F)
If .HasFormula Then TFml(F) = .Formula2R1C1 Else TFml(F) = Null
End With: Next F
LOt.HeaderRowRange.Offset(1).Resize(LMax).Value = TVals
For F = 1 To UBound(TFml)
If Not IsNull(TFml(F)) Then LOt.ListColumns(F).DataBodyRange.Formula2R1C1 = TFml(F)
Next F
End Property
[QUOTE="Dranreb, post: 20480214, member: 171206"]
Bonjour.
Je l'ai écrit donc je poste :
[CODE=vb]Option Explicit
Sub Copier()
Dim TSrc(), TCbl(), LSrc As Long, LCbl As Long, C As Integer
TSrc = Feuil2.ListObjects("T_LIVRAISONS_Livraisons").DataBodyRange.Value
ReDim TCbl(1 To UBound(TSrc, 1), 1 To 8)
For LSrc = 1 To UBound(TSrc)
If TSrc(LSrc, 24) Like "COMMANDE*" Then
LCbl = LCbl + 1
For C = 1 To 7: TCbl(LCbl, C) = TSrc(LSrc, C): Next C
TCbl(LCbl, 8) = TSrc(LSrc, 24)
End If
Next LSrc
TableauRetaillé(Feuil13.ListObjects("Tableau16"), LCbl) = TCbl
End Sub
Property Let TableauRetaillé(ByVal LOt As ListObject, Optional ByVal LMax As Long, TVals())
Dim Trop As Long, CMax As Long, TFml(), F As Long
If LMax = 0 Then LMax = UBound(TVals, 1)
Trop = LOt.ListRows.Count - LMax
If Trop > 0 Then
LOt.ListRows(LMax + 1).Range.Resize(Trop).Delete xlShiftUp
ElseIf Trop < 0 And LMax + Trop > 1 Then
LOt.ListRows(LMax + Trop).Range.Resize(-Trop).Insert xlShiftDown, xlFormatFromLeftOrAbove
End If
If LMax = 0 Then Exit Property
ReDim TFml(1 To LOt.ListColumns.Count)
For F = 1 To UBound(TFml)
With LOt.HeaderRowRange(2, F)
If .HasFormula Then TFml(F) = .Formula2R1C1 Else TFml(F) = Null
End With: Next F
LOt.HeaderRowRange.Offset(1).Resize(LMax).Value = TVals
For F = 1 To UBound(TFml)
If Not IsNull(TFml(F)) Then LOt.ListColumns(F).DataBodyRange.Formula2R1C1 = TFml(F)
Next F
End Property