VBA archivage dans une autre feuille

Bonjour,

j'ai un soucis avec mes lignes de commande archivage VBA, la formule que j'utilise devient par moment instable et fait planter mon classeur. Il s'agit d'un classeur partagé, la feuille planning m'indique l'etat avancement des pieces en cours une fois celle ci terminée de programmation la ligne passe en vert je peux donc archiver dans la feuille Archivage en saisissant la lettre "x" dans la colonne S. Ma formule VBA utilisé est la suivante:

  If (Target.Column = 19) Then
        If (UCase(Target.Value) = "X") Then
            Me.Rows(Target.Row).Copy
            shtArchivage.Activate
            shtArchivage.Rows(2).Insert Shift:=xlDown
            Me.Activate

Cette formule fait planter de temps a autre mon tableau rendant l'archivage automatique impossible. Erreur suivant s'affiche "Partie réparée: partie /xl/worksheets/sheet6.xml avec erreur XML. Erreur de chargement. Ligne 2, colonne 0.

"et

<?xml version="1.0" encoding="UTF-8" standalone="true"?>
-<recoveryLog xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main"><logFileName>error033640_01.xml</logFileName><summary>Des erreurs ont été détectées dans le fichier « H:\Documents\Gildas\Save\Aout\03082015\Planning programmation 17h45.xlsm »</summary>-<repairedParts summary="Liste des réparations :"><repairedPart>Partie réparée: partie /xl/worksheets/sheet6.xml avec erreur XML. Erreur de chargement. Ligne 2, colonne 0.</repairedPart></repairedParts></recoveryLog>

Je pense que ma formule est instable surtout quand j'archive plusieurs ligne a suivre.

Merci d'avance pour vos suggestions.

Gildas.

(pour des raisons de confidentialité j'ai supprimé quelques feuilles de mon classeur, le sheet6 du message erreur correspond bien a ma feuille archivage)

Sub Reset_Ligne()
Dim c As Range, cDest As Range

Application.ScreenUpdating = False
With ThisWorkbook
    'cDest: La celllule de destination: première cellule vide de la colonne A de Archivage
    With .Worksheets("Archivage")
        Set cDest = .Cells(.Rows.Count, "A").End(xlUp)(2)
    End With
    With .Worksheets("Planning")
    'on cherche LA CELLULE contenant x en colonne V de Feuille Planning
        Set c = .Range("V:V").Find("x", LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            With c.EntireRow
                'On copie toute la ligne trouvée vers cDest
                .Copy cDest
                'on supprime la ligne trouvée de Feuil1
                .Delete
            End With
            Set c = Nothing
        End If
        'on vide notre variable cDest
        Set cDest = Nothing
    End With
    Sheets("Archivage").Select
    Cells.FormatConditions.Delete
    Columns("A:A").Select
    Selection.Hyperlinks.Delete
    With Selection
        .VerticalAlignment = xlTop
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
End With

Sheets("Planning").Select

End Sub

Sub Transfert()
Dim LastLig As Long
Dim sDest As Worksheet ' Feuille de destination
Dim cDest As Range ' Cellule de destination
Dim lCount As Long ' Nombre de cellule copié
Dim lFirst As Long ' Premiere cellule de date

Application.ScreenUpdating = False
With ThisWorkbook
    'cDest: La celllule de destination: première cellule vide de la colonne A de Feuil2
    Set sDest = .Worksheets("Archivage")
    Set cDest = sDest.Cells(sDest.Rows.Count, "A").End(xlUp)(2)

    With .Worksheets("Planning")
        'Enlève l'éventuel filtre automatique
        .AutoFilterMode = False
        'LastLig, ligne de la dernière cellule remplie de colonne A de Archive
        LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
        'On fait un filtre automatique sur la colonne V de Planning avec comme critère "x"
        .Range("V2:V" & LastLig).AutoFilter field:=1, Criteria1:="x"
        'Si au moins une ligne résultat du filtre (en plus de la ligne 1 des titres)
        lCount = .Range("V2:V" & LastLig).SpecialCells(xlCellTypeVisible).Count
        If lCount > 1 Then
            With .Range("V3:V" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow
                'On copie toutes les lignes visibles vers cDest (sauf la ligne des titres)
                .Copy cDest
                'on supprime toutes les lignes visibles (sauf la ligne des titres)
                .Delete
            End With
            ' On récupère la première cellule de la copie
            lFirst = cDest.Rows(0).Row
            ' On écrit la date dans la plage définie
            sDest.Range(sDest.Cells(lFirst, "U"), sDest.Cells(lFirst + (lCount - 1), "U")).Value = Format(Now, "dd/mm/yyyy")
            sDest.Range(sDest.Cells(lFirst, "V"), sDest.Cells(lFirst + (lCount - 1), "V")).Value = Format(Now, "ww")
            sDest.Range(sDest.Cells(lFirst, "W"), sDest.Cells(lFirst + (lCount - 1), "W")).Value = Format(Now, "yyyy")
            sDest.Range(sDest.Cells(lFirst, "X"), sDest.Cells(lFirst + (lCount - 1), "X")).Value = 15
            sDest.Range(sDest.Cells(lFirst, "A"), sDest.Cells(lFirst + (lCount - 1), "A")).Hyperlinks.Delete
            sDest.Range(sDest.Cells(lFirst, "A"), sDest.Cells(lFirst + (lCount - 1), "A")).Font.Underline = False
            sDest.Range(sDest.Cells(lFirst, "A"), sDest.Cells(lFirst + (lCount - 1), "A")).HorizontalAlignment = xlCenter
            sDest.Range(sDest.Cells(lFirst, "A"), sDest.Cells(lFirst + (lCount - 1), "A")).Borders.Weight = xlThin
            sDest.Range(sDest.Cells(lFirst, "A"), sDest.Cells(lFirst + (lCount - 1), "A")).VerticalAlignment = xlVAlignCenter
            sDest.Range(sDest.Cells(lFirst, "U"), sDest.Cells(lFirst + (lCount - 1), "U")).HorizontalAlignment = xlCenter
            sDest.Range(sDest.Cells(lFirst, "U"), sDest.Cells(lFirst + (lCount - 1), "U")).Borders.Weight = xlThin
            sDest.Range(sDest.Cells(lFirst, "U"), sDest.Cells(lFirst + (lCount - 1), "U")).VerticalAlignment = xlVAlignCenter
            sDest.Range(sDest.Cells(lFirst, "V"), sDest.Cells(lFirst + (lCount - 1), "V")).HorizontalAlignment = xlCenter
            sDest.Range(sDest.Cells(lFirst, "V"), sDest.Cells(lFirst + (lCount - 1), "V")).Borders.Weight = xlThin
            sDest.Range(sDest.Cells(lFirst, "V"), sDest.Cells(lFirst + (lCount - 1), "V")).VerticalAlignment = xlVAlignCenter
            sDest.Range(sDest.Cells(lFirst, "W"), sDest.Cells(lFirst + (lCount - 1), "W")).HorizontalAlignment = xlCenter
            sDest.Range(sDest.Cells(lFirst, "W"), sDest.Cells(lFirst + (lCount - 1), "W")).Borders.Weight = xlThin
            sDest.Range(sDest.Cells(lFirst, "W"), sDest.Cells(lFirst + (lCount - 1), "W")).VerticalAlignment = xlVAlignCenter
            sDest.Range(sDest.Cells(lFirst, "X"), sDest.Cells(lFirst + (lCount - 1), "X")).HorizontalAlignment = xlCenter
            sDest.Range(sDest.Cells(lFirst, "X"), sDest.Cells(lFirst + (lCount - 1), "X")).Borders.Weight = xlThin
            sDest.Range(sDest.Cells(lFirst, "X"), sDest.Cells(lFirst + (lCount - 1), "X")).VerticalAlignment = xlVAlignCenter

        End If
        'on vide notre variable cDest
        Set cDest = Nothing
        'On enlève le filtre automatique
        .AutoFilterMode = False
    End With
End With
Sheets("Archivage").Select
    Cells.FormatConditions.Delete
    Columns("A:A").Select

    Selection.Hyperlinks.Delete

    Sheets("Planning").Select
End Sub