Deplacer des lignes sur une autre feuille

bonsoir à tous et à toutes.

-J’aimerai savoir si il est possible de deplacer des lignes tous les 1er de chaque mois, sur une autre feuille en fonction d’un critere " cloturé ou pas".
-Mon fichier comporte une feuille / mois et une feuille Annuel.
-Donc le 1er Fevrier il faudrait que les lignes « NON cloturés » de la feuille Janvier soient deplacées sur la feuille Fevrier et le 1er Mars il faudrait que les lignes « NON cloturés » de la feuille Fevrier soient deplacées sur la feuille Mars.
-Ainsi de suite pour les 12 mois.

  • il faudrait aussi que toutes les donnees des 12 feuilles soient regroupées sur la feuille Annuel.

je vous remercie par avance pour votre aide.

laurent
CA_MATERIEL_2025_V2.xlsm (273,8 Ko)

N’est-ce pas plus facile d’utiliser une feuille et d’ajouter quelque segments supplémentaires ?
Ce que vous demandez est possible mais n’est pas très pratique.

les lignes deplacees seront cloturées quand le chantier sera fini et cela peut prendre plusieurs annees c est pourquoi le faite de les deplacer de mois en mois est plus facile car sur un mois il peut y avaoir plus de 500 lignes.

Sub Deplacer()
     Dim i     As Integer, aMois, sMois1, sMois2, LO1, LO2, ptr, c1, c2, i1, i2, j
     Do
          i = Application.InputBox("Numéro du mois à copier" & vbLf & "arrêter=0", "Copier les ordres nonc-cloturés", Default = Month(Date), Type:=1)
     Loop While i < 0 Or i > 12
     If i = 0 Then Exit Sub
     aMois = Split(Replace(Replace(Join(Evaluate("text(column(A1:L1)*28,""[$-fr-fr]MMMM"")"), ","), "é", "e"), "û", "u"), ",")
     sMois1 = aMois(i - 1)
     sMois2 = aMois(i Mod 12)
     If vbYes <> MsgBox("Copier de " & Chr(34) & sMois1 & Chr(34) & " vers " & Chr(34) & sMois2 & Chr(34) & vbLf & " Correct?", vbYesNo) Then Exit Sub

     Set LO1 = Sheets(sMois1).Range("A9").ListObject
     Set LO2 = Sheets(sMois2).Range("A9").ListObject

     i2 = LO2.ListRows.Count                 'nombre de listrows actuelles dans LO2
     ptr = 0
     For i1 = LO1.ListRows.Count To 1 Step -1
          Set c1 = LO1.ListRows(i1).Range
          If c1.Cells(1, 14).Value = False Then     'cet ordre n'est pas encore clôturé
               ptr = ptr + 1
               Set c2 = LO2.ListRows.Add(i2 + 1).Range
               For j = 1 To LO1.ListColumns.Count
                    Select Case j
                         Case 1, 2, 3, 4, 6, 8, 9, 14, 16     'ces cellules ne sont pas des formules
                              c2.Cells(1, j).Value = c1.Cells(1, j).Value     'seulement les cellules sans formules
                    End Select
               Next
               LO1.ListRows(i1).Delete       'supprimer l'ancienne ligne
          End If
     Next

     With LO2.Range                          'aussi trier avec la date ascendant
          .Sort .Range("A1"), xlAscending, Header:=xlYes
          Application.Goto .Range("A1")
     End With


     MsgBox "on a copié " & ptr & " ligne(s) de " & Chr(34) & sMois1 & Chr(34) & " vers " & Chr(34) & sMois2 & Chr(34)
End Sub

Problème : pour decembre copier et coller dans janvier ???

1 « J'aime »

Bonjour Cow18.

1000 merci pour ton travail, c est exactement ce que je voulais.

Bonsoir Cow18,

Encore une fois merci,
Serait-il possible d’avoir la version « copier les lignes» au lieu de « déplacer les lignes » ?
Merci encore pour votre aide.

    LO1.ListRows(i1).Delete       'supprimer l'ancienne ligne
  

vous pouvez désactiver cett ligne en mettant un ’ en face (comme ça elle devient commentaire) oubien vous pouvez la supprimer.

1 « J'aime »