TRI automatique de données pour transfert vers fichier 2

Après réception du fichier, voici les modifications à apporter :

• supprimer le module 1
• supprimer le bouton
• remplacer le code du module 2 par le suivant :

Sub try()
Application.ScreenUpdating = False 'désactive la mise à jour de l'écran
Application.DisplayAlerts = False 'désactive les messages d'alerte d'Excel
Dim aa As String, myCell As Range, myAnchor As Range, mypath As String, wbS As Workbook, wbC As Workbook, wbsS As Worksheet 'déclare les variables

Set wbS = ThisWorkbook 'affecte le classeur source à la variable wbs
aa = "01.3.1 Chaussée" 'affecte la valeur à rechercher à la variable aa

If Application.WorksheetFunction.CountIf(Columns("V"), aa) > 0 Then 'vérifie  que aa existe dans la colonne v

    Sheets.Add after:=Sheets(Sheets.Count) 'ajoute une nouvelle feuille
    ActiveSheet.Name = "Tri" 'nomme la nouvelle feuille Tri
    Set wbsS = ActiveSheet 'affecte l'onglet actif à la variable wbss

    '   Sheets("FNE 2012").Range("A1", Sheets("FNE 2012").Cells(1, Columns.Count).End(xlToLeft)).Copy ActiveSheet.Range("A1") 'MERCI : )  !!!

        With Sheets("FNE 2012")
        .Range(.Range("A1"), .Cells(1, Columns.Count).End(xlToLeft)).Copy ActiveSheet.Range("A1") 'recopie l'en-tête
        Set myCell = .Columns("V").Find(aa, , xlValues, xlWhole) 'recherche la 1ere valeur aa dans la colonne V
        Set myAnchor = myCell ''note la plage dans laquelle se trouve la première valeur aa dans la variable myanchor

        Do 'établit la boucle qui va rechercher toutes les valeurs aa dans la colonne V
            Set myCell = .Columns("V").FindNext(myCell) 'repère la valeur aa
            .Range(.Cells(myCell.Row, 1), .Cells(myCell.Row, .Cells(1, Columns.Count).End(xlToRight).Column)).Copy ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) 'copie la ligne dans laquelle la valeur aa est retrouvée dans la feuille Tri
        Loop Until myAnchor.Address = myCell.Address 'continue la boucle jusqu'à ce que la boucle revienne à la 1ere plage dans laquelle la valeur aa a été trouvée... en premier
   End With
Else 'si la valeur aa n'existe pas dans la colonne V
    MsgBox "Il n'existe aucune occurence pour " & aa & "actuellement." 'affiche le message
    End 'stoppe la macro
End If

With wbS.Worksheets("Tri") 'trie le tableau
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=[H1]
    .Sort.SortFields.Add Key:=[J1]
    .Sort.SetRange Range("A1").CurrentRegion
    .Sort.Header = xlYes
    .Sort.Apply
End With

mypath = ThisWorkbook.Path 'enregistre dans la variable mypath le chemin d'acces au classeur source
If Dir(mypath & "\fichier2.xls") = "" Then 'vérifie que le classeur fichier2 n'existe pas
Workbooks.Add 'crée le classeur fichier2
wbsS.Cells.Copy Destination:=ActiveWorkbook.Sheets(1).Range("A1") 'copie la feuille Tri dans la 1ere feuille du classeur fichier2
    ActiveWorkbook.SaveAs Filename:=mypath & "\fichier2.xls" 'nomme le classeur fichier2 et le sauvegarde
Else 'si fichier2 existe
    Workbooks.Open Filename:=mypath & "\fichier2.xls" 'ouvre le classeur
    wbsS.Cells.Copy Destination:=ActiveWorkbook.Sheets(1).Range("A1") 'effectue la copie
    ActiveWorkbook.Save 'sauvegarde la copie
End If

wbsS.Delete 'efface la feuille Tri
Application.DisplayAlerts = True 'réactive les messages d'alerte Excel
Application.ScreenUpdating = True 'réactive l'écran

End Sub

- placer le code suivant dans le module de la feuille FNE 2012

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'procédure de lancement de la macro par double clic
If Not Intersect(Target, Range("A1")) Is Nothing Then
Cancel = True
Call try
End If
End Sub

le double clic sur la cellule A1 de la feuille FNE 2012 est à nouveau opérationnel.

Bonjour Game Over,

J'ai repositionné le code et la commande bouton dans le module pour la feuil FNE 2012

je n'ai pas de case active en A1 ?

Si je fais F8 sur le module de code, il s'arrête ici:

With wbS.Worksheets("Tri") 'trie le tableau

.Sort.SortFields.Clear

.Sort.SortFields.Add Key:=[H1]

Je recharge le fichier tel qu'il est maintenant dans la base de Free; même lien que hier soir

la feuil tri est créée avec les 56 lignes sélectionnées, ce qui correspond bien à la demande

Le fait de faire tourner sous différentes version Excel, tantôt sous 2007, sous 2010 ou 2003 n'a t il pas une incidence sur le bon fonctionnement ?

Je trouve pour ma part que ça marche mieux au bureau ( 2010) que chez moi (2003)

Salut,

tu n'as pas inséré le code lancement de la macro au bon endroit.

ok

je n'avais pas compris qu'il fallait ouvrir un module dédié à la commande

Ceci dit, j'ai toujours un arrêt au même endroit, au départ du tri du tableau, la ligne surlignée ci dessous est en jaune.

With wbS.Worksheets("Tri") 'trie le tableau

.Sort.SortFields.Clear

.Sort.SortFields.Add Key:=[H1]

.Sort.SortFields.Add Key:=[J1]

.Sort.SetRange Range("A1").CurrentRegion

.Sort.Header = xlYes

.Sort.Apply

End With

A vrai dire, je n'ai pas ce problème...

bon,

• stoppe la macro
• Supprime la feuille Tri de ton classeur
• place une apostrophe ' devant la ligne comme ceci

cela va désactiver la ligne.

- Relance la macro

Bon,

j'ai supprimé le tri

With wbS.Worksheets("Tri") 'trie le tableau

End With

et ça fonctionne, mais ce n'est pas forcément la bonne façon de procéder

j'ai mis un tri car sans lui, la première valeur trouvée se retrouve tout à la fin du tableau.

maintenant, ça n'affecte pas les résultats en eux même mais leur affichage

Pour ce point, s'il faut faire un tri à l'affichage dans le fichier 2, il faudrait le faire sur la colonne H "date d'évènement" de manière à retrouver le dernier évènement en bas de fichier.

Essaye ce code en remplacement de celui que tu as supprimé

wbS.Worksheets("Tri").Range("A1").CurrentRegion.Sort Key1:=wbS.Worksheets("Tri").Range("H1"), Key2:=wbS.Worksheets("Tri").Range("J1"), Header:=xlYes

Yes !!

Là ça marche, pas d'arrêt et tri sur la date col H

pour test, après création du fichier 2 je suis revenu à la BDD et j'ai ajouté deux lignes avec 01.3.1 Chaussée en col V

elles sont correctement prises en compte.

C'est pas mal du tout;

[b]Merci pour ce travail de code.

[/b]

Je dois encore faire le choix des colonnes à exporter vers le fichier 2; je vais surement "élaguer" en ne conservant que l'essentiel pour un traitement en phase 2; il me faut y réfléchir.

Plus tard, il me faudra pouvoir dans le même temps, créer un fichier3 puis un fichier4 avec respectivement des critères de choix autres toujours pris dans la colonne V mais je n'y suis pas encore.

Peut être que si on fait pour un fichier3, il sera possible de dupliquer le code pour un fichier4 ?? fichier5 ???

En tout cas tu maitrises bien, et ça m'a beaucoup aidé

lorsque le fichier2 sera propre, je devrais ajouter des colonnes ( au delà de AR ou de la dernière colonne copiée) pour un suivi d'intervention avec des cellules dates etc...

Je vais te laisser passer un bon WE, si le soleil veut bien se montrer ( ici en Essonne c'est pas encore ça )

Merci et à la semaine prochaine

Parfait, bon weekend

bonjour,

le code VBA de Game Over fonctionne bien: Il construit un fichier2 dans lequel il stocke les lignes sélectionnées dans le fichier BDDFNE selon le critère choisi.

Je désire faire un choix sur les colonnes copiées, en ne copiant pas toutes les colonnes comme la macro le fait actuellement , mais seulement certaines colonnes.

qui peut m'aider à modifier le module existant pour ne retrouver que les colonnes suivantes du fichier BDDFNE, dans le fichier2:

A G H I J K L M N O P Q T U V W X Y AM AR

http://accesgeneral1.free.fr/BDDFNE2012v1.xls

Salut,

Remplace dans la macro le ligne suivante :

wbS.Worksheets("Tri").Range("A1").CurrentRegion.Sort Key1:=wbS.Worksheets("Tri").Range("H1"), Key2:=wbS.Worksheets("Tri").Range("J1"), Header:=xlYes

par celle-ci

With wbS.Worksheets("Tri")
    .Range("A1").CurrentRegion.Sort Key1:=.Range("H1"), Key2:=.Range("J1"), Header:=xlYes
    .Range("AN:AQ,Z:AK,R:S,B:F").Delete
End With

vérifie que les colonnes que tu souhaites conserver sont toutes présentes et que le tri est correctement effectué.

With wbS.Worksheets("Tri")
    .Range("A1").CurrentRegion.Sort Key1:=.Range("H1"), Key2:=.Range("J1"), Header:=xlYes
    .Range("AN:AQ,Z:AL,R:S,B:F").Delete
End With

Ok merci Game Over, j'ai juste remplacé AK par AL ci dessus et c'est bon.

Le tri se fait correctement sur le critère date event puis heure.

Lors de la première activation la macro, crée le fichier2

Cependant à la seconde activation de la macro, le fichier2 est reconstruit, la macro écrase l’existant et ajoute à la suite les nouvelles lignes si elle en trouve.

Si le fichier2 comporte sur sa partie droite de nouvelles colonnes destinées à être complétées il y a un risque d’écrasement de ces données par la macro lors de chaque activation.

En clair, la macro pourrait elle se contenter de chercher les lignes nouvelles et les ajouter à la suite sans revenir sur l’existant du fichier2 ??

L'idée serait de ne pas écraser la zone après la colonne T et de reprendre l’écriture sous la dernière ligne écrite la fois précédente.

Je ne sais pas si je suis clair ?

Essaye en remplaçant

wbsS.Cells.Copy Destination:=ActiveWorkbook.Sheets(1).Range("A1") 'effectue la copie

par

wbsS.Range("A1").CurrentRegion.Copy Destination:=ActiveWorkbook.Sheets(1).Range("A1") 'effectue la copie

Il faudra que tu laisses au moins une colonne vide entre le tableau et les données que tu vas ajouter dans fichier2

... [EDIT]

à la réflexion, pas besoin de colonne vide dans fichier2

J'ai pas fait de test

Oui, on peut laisser une colonne vide sans problème colonne U

je vais voir si ça marche

Bon,

les colonnes à partir de U ne sont pas touchées on peut donc les gérer indépendamment des colonnes A à T

mais la commande ré écrit les colonnes A à T. Pourrait on ne pas revenir sur les lignes existantes à la seconde écriture du fichier2 mais juste compléter par des lignes supp ( 60, 61, 62... ) s' il trouve la variable aa dans les nouvelles lignes de BDDFNE ??

cela veut donc dire que les lignes existantes ne seront jamais modifiées dans le fichier BDDFNE2012 !

on est d'accord ?

Oui c'est correct

On garde la main, on pourrait modifier, mais une fois saisie, la ligne ne change plus sauf correction très rare. De plus, si c'est le cas on pourra corriger le fichier2

Remplace la partie de code suivante (tout à la fin)

Else 'si fichier2 existe
    Workbooks.Open Filename:=mypath & "\fichier2.xls" 'ouvre le classeur   
    wbsS.Range("A1").CurrentRegion.Copy Destination:=ActiveWorkbook.Sheets(1).Range("A1") 'effectue la copie
    ActiveWorkbook.Save 'sauvegarde la copie
End If

par

Else 'si fichier2 existe
    Workbooks.Open Filename:=mypath & "\fichier2.xls" 'ouvre le classeur
    With wbsS
        derLig = ActiveWorkbook.Sheets(1).Range("A1").End(xlDown).Row + 1
        derCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
        If Not IsEmpty(.Cells(derLig, 1)) Then
            .Range(.Cells(derLig, 1), .Cells(.Range("A1").End(xlDown).Row, derCol)).Copy Destination:=ActiveWorkbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        End If
    End With

    ActiveWorkbook.Save 'sauvegarde la copie
End If

à tester