Archivage vers plusieurs feuilles sauf dernière ligne

[grassetruc]

Bonjour à tous,

Je bricole en vba.

Depuis plusieurs jours je bute sur mon projet d'archivage.
Je vous joints un exemple pour être un peu plus explicite, avec mon code qui ne fonctionne pas.
Soyez indulgents, je bricole ...

Le but est d'archiver les fiches clôturées ("F" renseignées) dans l'onglet correspondant à l'année de création de la fiche ("B").
Cependant, mes fiches sont ajoutées sur la feuille ("EnCours") par formulaire avec incrémentation du numéro ("A").
Par conséquent, il ne faut pas que la dernière ligne soit archivée.

Si quelqu'un pouvait venir à mon secours ...

Merci par avance à l'intérêt que vous porterez à ma requête.

Amicalement

Grassetruc

 

[grassetruc]

Re : Archivage vers plusieurs feuilles sauf dernière ligne

Re bonjour,

Oups, mon fichier joint n'est pas passé, le voici.

 

[CHALET53]

Re : Archivage vers plusieurs feuilles sauf dernière ligne

Bonjour,

si j'ai compris : en rajoutant le code en gras

For Each i In Range("F2:F" & dl)

If i.Row = dl Then GoTo suite
If Not IsDate(i.Value) Then GoTo suite
j = i.Offset(0, -4)
Onglet = Format(j, "yyyy")
If i = "" Then
Exit Sub
End If

If i > 0 Then

i.EntireRow.Select 'sélectionne la ligne
Selection.Cut

Sheets(Onglet).Select
dld = Range("A2000").End(xlUp).Row + 1
Range("A" & dld).Select
ActiveSheet.Paste


Sheets("EnCours").Select
Selection.Delete Shift:=xlUp
End If 'Fin de la condition
suite:

 

[grassetruc]

Re : Archivage vers plusieurs feuilles sauf dernière ligne

re boujour au Forum

Bonjour Chalet53

Merci pour ta réponse, je l'ai testée, j'ai toujours le même problème , la dernière ligne s'archive et perturbe l'incrémentation des fiches.

Je ne peux regarder plus aujourd'hui, le devoir m'appelle, je verrai ça demain.

Encore merci pour ton attention

Grassetruc

 

[CHALET53]

Re : Archivage vers plusieurs feuilles sauf dernière ligne

Je n'ai sans doute pas bien interprété la problématique
Dans mes essais sur ton fichier, la dernière ligne reste sur la feuille Encours
en réalité seule la 2ème ligne est archivée : c'est la seule avec une date colonne F

 

[grassetruc]

Re : Archivage vers plusieurs feuilles sauf dernière ligne

Bonjour le forum

Bonjour Chalet53

J'ai rajouté des éléments au tableau, en mettant une date de clôture à la dernière fiche. J'ai testé ton code, mon problème persiste.
En faisant le pas à pas, j'ai remarqué que la valeur de "dl" ne variait jamais alors qu'elle devrait diminuer à chaque archivage.
Je vais bosser sur ce problème. Si tu as une idée, elle sera toujours la bien venue.

Encore merci
grassetruc

 

[CHALET53]

Re : Archivage vers plusieurs feuilles sauf dernière ligne

bonsoir,

Peut-être en modifiant la logique de traitement : essaie ce programme

Sub ArchivageLev()
Dim Onglet
Dim i
Dim j As Date
Dim dl
Dim dld

With Sheets("EnCours")
dl = Range("A2000").End(xlUp).Row

For i = dl To 2 Step -1

a = Cells(i, 1).Row
If Cells(i, 1).Row = dl Then GoTo suite
If Not IsDate(Cells(i, 6).Value) Then GoTo suite
j = Cells(i, 2).Value
Onglet = Format(j, "yyyy")
If i = "" Then
Exit Sub
End If

If Cells(i, 6) > 0 Then

Cells(i, 1).EntireRow.Select 'sélectionne la ligne
Selection.Cut

Sheets(Onglet).Select
dld = Range("A2000").End(xlUp).Row + 1
Range("A" & dld).Select
ActiveSheet.Paste


Sheets("EnCours").Select
Selection.Delete Shift:=xlUp

End If 'Fin de la condition
suite:

Next 'Fin de la boucle
End With
End Sub

 

[grassetruc]

Re : Archivage vers plusieurs feuilles sauf dernière ligne

Bonjour le forum
Bonjour Chalet53

Merci pour ta réponse.
J'ai regardé ton code avant de le tester. Certes il marche nickel, mais tu as défini une variable a que tu n'utilise plus. Je l'ai supprimée, le résultat est excellent.

Merci pour la résolution de mon problème.

grassetruc