CelluleVide
XLDnaute Occasionnel
Bonjour a tous,
j'ai récupérer cette macro d'archivage de BrunoM45:
Mais je bute sur l'adaptation de la ligne: TabSht = Split("Technique,Product°", ",") a mon fichier.
Que dois-je mettre en remplacement de "Technique, Production°" pour que cela fonctionne?
est-ce les entetes de mes colonnes ou autre chose?
Merci
A+
Edit: Suite a la remarque de TOTOTITI, il m'aura bien fallut 197 messages pour savoir comment mettre le code entre balises
Je ferai attention a l'avenir.
J'ai aussi pris le temps d'ajouter un fichier: Le but est de copier les lignes Marquées "Terminé" dans la feuille "Actions" vers la feuille "Archivage puis les supprimer de la feuille "Action"
j'ai récupérer cette macro d'archivage de BrunoM45:
Mais je bute sur l'adaptation de la ligne: TabSht = Split("Technique,Product°", ",") a mon fichier.
Que dois-je mettre en remplacement de "Technique, Production°" pour que cela fonctionne?
est-ce les entetes de mes colonnes ou autre chose?
Merci
A+
Edit: Suite a la remarque de TOTOTITI, il m'aura bien fallut 197 messages pour savoir comment mettre le code entre balises
Je ferai attention a l'avenir.
J'ai aussi pris le temps d'ajouter un fichier: Le but est de copier les lignes Marquées "Terminé" dans la feuille "Actions" vers la feuille "Archivage puis les supprimer de la feuille "Action"
Code:
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 ACTIONS
With Sheets("ACTIONS")
' 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("F" & Lig).Value = "Terminé" 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
Dernière édition: