Microsoft 365 VBA copier-coller selon conditions

Sub copiePV()
    Application.ScreenUpdating = False

    Dim WsS As Worksheet, WsC As Worksheet
    Dim Cel As Range, C As Range
    Dim LigneAjout As Long

    Application.ScreenUpdating = False

    Set WsS = Worksheets("Export")
    Set WsC = Worksheets("Ventes")

    For Each Cel In WsS.Range("A2:A" & WsS.Range("A" & Rows.Count).End(xlUp).Row)
        If IsError(Application.Match(Cel, WsC.[a:a], 0)) Then '**** Ajouté
            Set C = WsC.Columns(1).Find(Cel, , xlValues, xlWhole)
            LigneAjout = WsC.Range("A" & Rows.Count).End(xlUp).Row + 1

            If Not C Is Nothing Then
                Cel.Resize(, 16).Copy WsC.Range("A" & C.Row)
            Else
                Cel.Resize(, 16).Copy WsC.Range("A" & LigneAjout)
                LigneAjout = LigneAjout + 1
            End If
        End If ' ajouté '*****
    Next Cel
    Set C = Nothing: Set WsS = Nothing: Set WsC = Nothing

    Application.ScreenUpdating = True

End Sub

Sub CopieExtoVentes()
    Dim DicoVentes As Object
    Dim TabExp() As Variant
    Dim TabToCopy() As Variant
    
    Application.ScreenUpdating = False
    
    Set DicoVentes = CreateObject("scripting.dictionary")
    With Sheets("Ventes").ListObjects("t_Ventes")
        For i = 1 To .ListRows.Count
            clé = .DataBodyRange(i, 1)
            If Not DicoVentes.exists(clé) Then
                DicoVentes.Add clé, i
            End If
        Next i
    End With
    
    With Sheets("Export").ListObjects("t_Export")
        TabExp = Application.WorksheetFunction.Transpose(.DataBodyRange.Value2)
    End With
    
    NbLignes = 0
    For j = LBound(TabExp, 2) To UBound(TabExp, 2)
        clé = TabExp(1, j)
        If Not DicoVentes.exists(clé) Then
            NbLignes = NbLignes + 1
            ReDim Preserve TabToCopy(1 To 14, 1 To NbLignes)
            For i = LBound(TabExp, 1) To UBound(TabExp, 1)
                TabToCopy(i, NbLignes) = TabExp(i, j)
            Next i
            
        End If
    Next j
    
    If NbLignes <> 0 Then
        With Sheets("Ventes").ListObjects("t_Ventes")
            ind = .ListRows.Add.Index
            .DataBodyRange(ind, 1).Resize(UBound(TabToCopy, 2), UBound(TabToCopy, 1)) = Application.WorksheetFunction.Transpose(TabToCopy) 'Application.WorksheetFunction.Transpose
        End With
    End If
    
    Set DicoVentes = Nothing
    Application.ScreenUpdating = True
End Sub