Option Explicit ' Améliore la rapidité du code et permet de trouver rapidement les erreurs
Sub Archivage()
Dim DLig As Long, Lig As Long, NLig As Long
Dim ShtA As Worksheet
Dim NumConstat As String
' Définir l'objet feuille archivage
Set ShtA = Sheets("Archivage")
' Avec la feuille QUALIE
With Sheets("Qualité")
' Trouver la dernière ligne du tableau
DLig = .Range("A" & Rows.Count).End(xlUp).Row
' Pour chaque ligne de la fin au début car nous allons supprimer des lignes
For Lig = DLig To 3 Step -1
If .Range("W" & Lig).Value = "fermé" Then
' Mémoriser le numéro de constat
NumConstat = .Range("A" & Lig).Value
' trouver la prochaine ligne vide de la feuille archivage
NLig = ShtA.Range("A" & Rows.Count).End(xlUp).Row + 1
' Copier collage spécial valeur la ligne
.Range("A" & Lig).EntireRow.Copy
ShtA.Range("A" & NLig).PasteSpecial xlPasteFormats
ShtA.Range("A" & NLig).PasteSpecial xlPasteValues
' Supprimer la ligne
.Range("A" & Lig).EntireRow.Delete
' Supprimer la ligne dans les autres feuilles
SupLigne (NumConstat)
End If
Next Lig
End With
Application.CutCopyMode = False
End Sub
Sub SupLigne(NumConstat As String)
Dim Ind As Integer, LigF As Long, TabSht() As String
' Définir le tableau des feuilles dans lesquelles supprimer les lignes
' ATTENTION à l'ordre des feuilles
TabSht = Split("Technique,Product°", ",")
' Pour chaque feuille du tableau
For Ind = 0 To UBound(TabSht)
On Error Resume Next
' trouver la ligne correspondante
LigF = 0: LigF = Sheets(TabSht(Ind)).Range("A:A").Find(What:=NumConstat, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row
If LigF <> 0 Then
' Si la ligne a été trouvée, on la supprime
Sheets(TabSht(Ind)).Range("A" & LigF).EntireRow.Delete
Dim Dligf As Long
Dligf = Sheets(TabSht(Ind)).Range("A" & Rows.Count).End(xlUp).Row
Sheets(TabSht(Ind)).Range("A" & Dligf).Copy Destination:=Sheets(TabSht(Ind)).Range("A" & Dligf + 1)
Else
' sinon il y'a comme un problème
MsgBox "Etrange, la ligne du constat n° " & NumConstat & " n'a pas été touvée !?"
End If
Next Ind
End Sub