Archivage

[ggtruc]

Bonjour le forum, bonjour les rois du VBA

Mon souhait ....

J'ai une base de données qui me sert à gérer les entrées et les sorties de véhicules dans un garage. Cette base est composée ainsi:
en feuille ("en cours")
colonne A : numéro d'ordre incrémenté sous la forme 12 - 0001 ("YY" "-" i)
colonne B : date entrée véhicule
colonne C: marque
......
colonne H: date de transfert éventuel vers une autre unité
......
colonne R: date du sortie du garage.

Comme annoncé dans le titre, je désire effectuer un archivage automatique de ces données.
Le but est le suivant, à l'ouverture du fichier, lorsque les éléments de la colonne H ou R sont renseignées, que ceux-ci soient coupés, et collés dans la feuille dont l'intitulé correspond à "YYYY" de la colonne B.
Il est évident que, pour respecter l'incrémentation du numéro d'ordre, le dernier élément ne pourra jamais être archivé.

Je ne peux malheureusement pas vous poster un fichier exemple, je n'ai excel que sur mon lieu de travail et sans connexion internet.

Par avance, merci à tous de bien vouloir vous pencher sur mon problème.
Je dispose de Excel, version 2003. Je suis débutant en VBA, j'ai construit quelques codes me permettant de renseigner ma base par userforms, mais là, je bloque, j'ai un problème avec la déclaration des variables.

 

[MJ13]

Re : Archivage

Bonjour GGtruc

Notre souhait .... Sinon, on va galérer

Avoir au moins un fichier sans données confidentielles avec juste avant et après, ce que tu désires traiter. Mais on a pas besoin de toutes les colonnes. juste quelques unes. Ensuite tu pourras adapter à ton fichier.

Tu peux toujours mettre ton fichier sur une clé USB.

 

[ggtruc]

Re : Archivage

Bonjour le forum,

Voila comme demandé, je joints un fichier exemple.

Merci par vance

 

[MJ13]

Re : Archivage

Re

Voici une possibilité pour envoyer les lignes Transfert.

J'ai ajouter une colonne année, pour que ce soit plus simple et c'est bien d'avoir un maximum de renseignements dans une Base de données.

 

[ggtruc]

Re : Archivage

Bonjour à tous,

Merci MJ13 pour ta réponse, ce n'est pas exactement ce que je recherchais mais je vais essayer d'adapter.
Je n'ai pas bien compris pourquoi tu as mis un compteur dans l’entête de la colonne 15 des feuilles 2011 et 2012.
Encore merci, je te tiens au parfum
A+

 

[MJ13]

Re : Archivage

Re

pourquoi tu as mis un compteur dans l’entête de la colonne 15

C'est pour ne pas avoir en macro à calculer la dernière ligne de la feuille. Mais tu peux le mettre dans la macro comme pour derl.Ce qui donnerait:

Public i
Sub Transfert()
'transfert sur colonne 10 non vide
Sheets("En cours").Select
derl = Sheets("En Cours").Range("A65536").End(xlUp).Row + 1
  For i = derl To 2 Step -1
   If Cells(i, 10) <> "" Then Rows(i & ":" & i).Select: Selection.Copy: copie
  Next
End Sub
Sub copie()
'MsgBox Cells(i, 14).Text
Sheets(Cells(i, 14).Text).Select
derlAct = ActiveSheet.Range("A65536").End(xlUp).Row + 1
'Range("A" & ActiveSheet.Cells(1, 15).Value).Select
Range("A" & derlAct).Select
ActiveSheet.Paste
Sheets("en cours").Select
Application.CutCopyMode = False
End Sub

 

[ggtruc]

Re : Archivage

Salut MJ13

En actionnant à plusieurs reprises le bouton transfert, je me suis rendu compte de l'utilité de ce compteur. Seulement, j'ai un petit problème, chaque fois que je l'actionne, c'est toujours la même ligne qui est copiée et l'originale de la feuille "en cours" n'est pas supprimée.
Merci encore de t’être penché sur mon problème.
A+

 

[camarchepas]

Re : Archivage

Bonjour,

Une autre façon de faire :

Le code peut être optimisé , mais je pense qu'il réalise ce que tu demandes

Option Explicit

Sub Transfert()
Dim LigneMax As Long
Dim Tourne As Long
Dim Année As String
'Dernière ligne renseignée -1 pour conserver
LigneMax = Sheets("en cours").Range("A" & Rows.Count).End(xlUp).Row - 1

'Boucle de l'avant dernière à la 2° ligne
For Tourne = LigneMax To 2 Step -1
 If Sheets("en cours").Range("J" & Tourne) <> "" Then
   Année = Year(Sheets("en cours").Range("E" & Tourne))
   Sheets("en cours").Rows(Tourne).Copy Destination:=Sheets(Année).Rows(Sheets(Année).Range("O1"))
   Sheets(Année).Range("A" & Sheets(Année).Range("O1") - 1 & ":N" & Sheets(Année).Range("O1") - 1).Interior.ThemeColor = xlThemeColorAccent6
   Sheets("en cours").Rows(Tourne).Delete
  Else
   If Sheets("en cours").Range("M" & Tourne) <> "" Then
    Année = Year(Sheets("en cours").Range("E" & Tourne))
    Sheets("en cours").Rows(Tourne).Copy Destination:=Sheets(Année).Rows(Sheets(Année).Range("O1"))
    Sheets(Année).Range("A" & Sheets(Année).Range("O1") - 1 & ":N" & Sheets(Année).Range("O1") - 1).Interior.Color = 5296274
    Sheets("en cours").Rows(Tourne).Delete
   End If
 End If
Next Tourne
End Sub

 

[ggtruc]

Re : Archivage

Bonjour le forum,
Bonjour camarchepas

Je viens de prendre connaissance de ta solution, je vais la tester demain, je te tiens au courant.
Merci à toi
A+

 

[ggtruc]

Re : Archivage

Bonjour le forum, bonjour camarchepas

J'ai testé ton code, qui ressemble un petit peu à ce que j'avais étabi de mon côté. Je bloque toujours au même endroit, à la déclaration de la dernière ligne (LigneMax), il m'affiche une erreur 1004. Je ne comprends par pourquoi. Aurais-tu une autre solution?
Merci encore pour ce que tu m'a déjà présenté.
A+

 

[camarchepas]

Re : Archivage

Bonsoir ,

Vous joint le fichier test que j'ai remis en l'état pour refaire le test , il suffit d'appuyer sur le bouton transfert .

Essayé plus de vingt fois avec le même code.

Testé en Excel 2010 et 2003 , cela fonctionne . peut être un problème lors de l'implantation du code