Copier coller dans un tableau

Bonjour à tous,

J'ai réalisé une macro qui permet de copier des données et de les coller dans un tableau. Les données collées ne veulent pas s'afficher dans le tableau avez-vous une idée de pourquoi ?

Merci d'avance

Sub Adjustment()
Dim dlg As Integer, lig As Integer
Dim cel As Range

Application.ScreenUpdating = False

With Sheets("COSTING")
    On Error Resume Next
    .ListObjects("Tabcosting").DataBodyRange.Delete 'ListRows.Add
    On Error GoTo 0
    dlg = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A3:E" & dlg).Copy
    .Range("Tabcosting[RPL Family]").PasteSpecial Paste:=xlPasteValues
    .Range("I3:I" & dlg).Copy
    .Range("Tabcosting[Shipment (Stock Lens)]").PasteSpecial Paste:=xlPasteValues
    .Range("K3:K" & dlg).Copy
    .Range("Tabcosting[Wip Stock ]").PasteSpecial Paste:=xlPasteValues
    .Range("AA3").FormulaR1C1 = "=RC[-14]+RC[-21]"
    .Range("AB3").FormulaR1C1 = "=RC[-14]+RC[-21]"
    .Range("AC3").FormulaR1C1 = "=IFERROR([@[Good Qty]]/[@[Launched Qty]],"""")"
    .Range("AE3").FormulaR1C1 = "=RC[-16]+RC[-21]"

        For Each cel In .ListObjects("Tabcosting").ListColumns(1).DataBodyRange
        On Error Resume Next
        lig = WorksheetFunction.Match(cel.Value, Sheets("FILTRE").Range("A:A").EntireColumn, 0)
        If lig > 0 Then
            cel.Offset(0, 5) = Sheets("FILTRE").Range("F" & lig).Value
            cel.Offset(0, 6) = Sheets("FILTRE").Range("B" & lig).Value
            cel.Offset(0, 7) = Sheets("FILTRE").Range("C" & lig).Value
            cel.Offset(0, 8) = Sheets("FILTRE").Range("E" & lig).Value
            cel.Offset(0, 15) = Sheets("FILTRE").Range("D" & lig).Value
        End If
        lig = 0
    Next cel
End With

Application.ScreenUpdating = True

End Sub

Bonjour,

Pour déboguer un programme, il est préférable de désactiver la gestion d'erreur. Dans le cas présent, c'est la fonction Match qui pose problème lorsque aucune correspondance n'est trouvée. Une version révisée à tester :

Sub Adjustment()

Dim dlg As Integer, lig As Integer, cel As Range

Application.ScreenUpdating = False
With Sheets("COSTING")
    .ListObjects("Tabcosting").DataBodyRange.Delete 'ListRows.Add
    dlg = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A3:E" & dlg).Copy
    .Range("Tabcosting[RPL Family]").PasteSpecial Paste:=xlPasteValues
    .Range("I3:I" & dlg).Copy
    .Range("Tabcosting[Shipment (Stock Lens)]").PasteSpecial Paste:=xlPasteValues
    .Range("K3:K" & dlg).Copy
    .Range("Tabcosting[Wip Stock ]").PasteSpecial Paste:=xlPasteValues
    .Range("AA3").FormulaR1C1 = "=RC[-14]+RC[-21]"
    .Range("AB3").FormulaR1C1 = "=RC[-14]+RC[-21]"
    .Range("AC3").FormulaR1C1 = "=IFERROR([@[Good Qty]]/[@[Launched Qty]],"""")"
    .Range("AE3").FormulaR1C1 = "=RC[-16]+RC[-21]"
    For Each cel In .ListObjects("Tabcosting").ListColumns(1).DataBodyRange
        For lig = 2 To Sheets("FILTRE").Range("A" & Rows.Count).End(xlUp).Row
            If Sheets("FILTRE").Range("A" & lig) = cel.Value Then
                cel.Offset(0, 5) = Sheets("FILTRE").Range("F" & lig).Value
                cel.Offset(0, 6) = Sheets("FILTRE").Range("B" & lig).Value
                cel.Offset(0, 7) = Sheets("FILTRE").Range("C" & lig).Value
                cel.Offset(0, 8) = Sheets("FILTRE").Range("E" & lig).Value
                cel.Offset(0, 15) = Sheets("FILTRE").Range("D" & lig).Value
                Exit For
            End If
        Next lig
    Next cel
End With

End Sub

D'accord merci beaucoup !

Bonne soirée