-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.
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 ???