Archiver, supprimer et créer des lignes avec formules

[Bocepod]

Bonjour,

Après quelques semaines passées sur mon tableau et après avoir arpenté le forum de long en large, je n'arrive pas à réaliser les macros (manuelles ou vba) nécessaires pour mon fichier

Ce fichier se compose de 4 feuilles (production, technique, qualité et achivage). La feuille Qualité est le récapitulatif des autres 3 autres feuilles qui sont remplies par différents services. Une fois les feuilles remplies et les différents contrôles effectués, l'utilisateur final valide les données en passant la dernière cellule de la ligne de la feuille "qualité" de "ouvert" à "fermé". Cette ligne passe alors en vert.

Je souhaite créer une macro qui, affecté à un bouton, permettra d'archiver cette ligne (en utilisant la fonction de cellule active) dans la feuille "archivage". Les lignes ainsi archivées se colleront les unes à la suite des autres.

Par la suite, je voudrai pouvoir supprimer dans les feuilles Production, Technique et Qualité les lignes qui ont été archivées mais aussi créer des lignes vierges à la fin des tableaux des ces trois feuilles (avec conservation des formules mais sans les valeurs).

Ma demande est complexe mais je commence à être limité en termes de technique vba.
Je vous remercie par avance de vos réponses et de l'aide que vous pourrez m'apporter.

Bocepod

 

[Compte Supprimé 979]

Re : Archiver, supprimer et créer des lignes avec formules

Bonjour Bocepod et bienvenue sur ce forum

Voici ce que fait mon code ci-dessous
- archivage des lignes marquées "fermé"
- suppression des lignes archivées
- création d'une ligne vierge à chaque suppression

Essayes le et tiens nous au courant

En revanche nettoie correctement tes tableaux
pour ne pas laisser trainer des cellules contenant des valeurs dans la colonne A
alors que la ligne elle même ne contient rien

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

A+

 

[Bocepod]

Re : Archiver, supprimer et créer des lignes avec formules

Bonjour et merci pour la réponse.

J'ai testé cet AM. cela a fonctionné une fois en archivant les lignes au milieu de la feuille Archivage. Puis impossible de la refaire fonctionner même en ajoutant de nouvelles données.

Je suis un peu perdu!!!

cordialement,

 

[Bocepod]

Re : Archiver, supprimer et créer des lignes avec formules

Je renvoie le fichier modifié. Si cela peut servir.

 

[Bocepod]

Re : Archiver, supprimer et créer des lignes avec formules

Bonjour et Meilleurs voeux à tous.
Après avoir tenté plusieurs essais et laisser un peu de côté mon problème, je vous relance pour un petit coup de main. Si des fois qqun avait une idée pour régler mon problème de macro.

Par avance Merci...

Cordialement,