Excel 2007 - VBA: Copie de plusieurs ligne trouvée via .Find

Le 09/04/2014 à 13:21

Bonjour à tous,

Je dois faire un fichier sous Excel 2007 pour mon usage personnel mais au boulot qui me permet de gérer mes demandes d'interventions en interne.

J'ai donc plusieurs feuilles dans mon classeur. Une ressemblant à un formulaire pour l'encodage de la demande d'intervention avec un bouton sur lequel une macro est affectée qui copie les infos remplient dans ce formulaire (feuille 'ouverture'), dans une autre feuille appelée 'Listing' mais qui génère également un numéro d'incident automatiquement en fonction du numéro de ligne.

J'ai donc également une troisième feuille s’appelant 'Cloture' avec un bouton en bas de formulaire qui copie également les infos sur la ligne correspondante à l'incident encodé précédemment lors de la demande dans la feuille 'Listing' (j'encode manuellement dans une cellule le numéro d'incident et cela me pré-rempli le formulaire en allant cherché les données dans la feuille 'Listing'.

Ce que j'ai fais c'est une feuille supplémentaire (appelée 'recherche') me permettant de voir en un coup d’œil les incidents non clôturés.

Et c'est là que je coince.

Le but de la macro est de chercher dans un colonne précise chaque ligne ou se trouve le mot "NON" et je voudrais que les données correspondantes à ces lignes apparaissent dans le tableau de cette feuille.

Le problème c'est que je suis nul en programmation et que là ça devient un peu trop complexe dans le sens ou mon fichier a deux variables différentes pour chercher les lignes correspondantes pour la source et la destination qui sont dans deux feuilles différentes. D'autant plus que je vais devoir faire sans aucun doute une boucle avec condition pour que la macro applique le même type de copie pour chaque ligne avec le mot "NON".

Je vous donne le code de cette macro. Il y a beaucoup de chose que j'ai mis en commentaire car cela ne fonctionne pas et je ne suis pas très méthodique en programmation.

Sub Bouton_search_Open()

Dim OpenInc As Range
Dim Free_Lig As Long
Dim FirstRow As Long
'Dim FirstFound As Range

    With Sheets("Recherche")                                    'dans cette feuille
        .Range("B8", "K1048576").ClearContents                  'nettoyage du tableau de recherche des incidents ouverts
        Free_Lig = .Range("B" & Rows.Count).End(xlUp).Row + 1   'recherche de la ligne libre
    End With

    With Sheets("Listing").Range("N:N")                         'dans cette feuille et dans la colonne 'N'
        Set OpenInc = .Find("NON", LookIn:=xlValues)
    End With

    With Sheets("Recherche")
        If Not OpenInc Is Nothing Then
            FirstRow = OpenInc.Row
            'FirstFound = OpenInc.Address
                'Do
                Sheets("Listing").Range("A:J").Rows(FirstRow).Select
                Selection.Copy
                Sheets("Recherche").Select
                Range("B").Rows(Free_Lig).Select
                ActiveSheet.Paste
                'Worksheets("Listing").Range("A:J").Rows(FirstRow).Copy 'Worksheets("Recherche").Range("B").Rows(Free_Lig)

                'Set OpenInc = .FindNext(OpenInc)
                'Loop While OpenInc.Address <> FirstFound

            'Else
            'MsgBox "Il n'y aucun incident ouvert actuellement!"
        End If

    End With

End Sub

Je vous donne aussi directement le fichier là ou j'en suis actuellement, vous pourrez mieux vous rendre compte du but de ce fichier.

A l'avenir il me permettra aussi de faire des analyses (graphiques ou autres...)

Cela fait des jours que je passe des heures dessus et j'en ai marre d'avoir des lignes de codes surlignées en jaunes!

Si quelqu'un pouvait au moins me mettre sur la piste et me dire mes erreurs car j'ai besoin d'apprendre aussi pour les futurs fichiers que je vais sans doute devoir créer.

Un grand merci d'avance à la communauté!

Ben

25interventions-br.xlsm (96.89 Ko)

Le 09/04/2014 à 13:57

Bonjour,

A tester.

33interventions-br.xlsm (98.68 Ko)

Le 09/04/2014 à 14:10

Bonjour

Ci joint une proposition reposant sur les filtres

A tester

Cordialement