Macro vba excel 2010 Tableau

Version imprimable

08/12/2014, 09h48
lovlov33

1 pièce(s) jointe(s)

Macro vba excel 2010 Tableau

Bonjour la communauté,

quelqu'un pourrait-il m'aider ?
En effet j'ai un fichier excel avec 2 feuilles.
J'ai une macro vba (ROP) qui m’insère automatiquement un petit tableau a remplir a chaque incident.
Maintenant je voudrais créer une macro, qui lors de la fin de l’événement Bascule toutes les cases grisées du tableau, vers le tableau récapitulatif de la feuille CRJ.
En gros je voudrais que les cases A5,B5,B12,K10,A8et A9 de la feuille suivi Rop soit mise automatiquement lors de la fermeture de l'évenement dans la feuille CRJ dans les cases A9,F9,D9,I9,B9,C9. Bien sur je veux que ce transfert se fasse pour chaque incident et que les infos se mettent les unes sous les autres a chaque clôture d'incident .
Petite particularité , tous les tableaux incident doivent rester affichés.
Je ne sais pas comment m' y prendre ,

A l'aide s'il vous plait
08/12/2014, 11h46
Daniel.C

Bonjour,

Citation:

lors de la fin de l’événement...

C'est quoi, la fin de l’événement ?
08/12/2014, 12h08
lovlov33

fin de l'événement

Bonjour,
La fin de l'événement c'est le moment ou l'on clôture le tableau et que l'on transféré les données dans le tableau se situant dans la feuille CRJ .
08/12/2014, 12h15
Daniel.C

Est-ce qu'on considère que l'événement est terminé quand toutes les cellules A5,B5,B12,K10,A8 et A9 sont remplies ou faut-il un bouton pour provoquer la copie ?
08/12/2014, 13h42
lovlov33

Re bonjour,

En fait je travaille pour une societe de transport. Ce qu'on appelle evenement c'est en fait un incident . Quand l'incident est terminé, je voudrais pouvoir cloturé le tableau correspondant en transferant les données de celui-ci dans le tableau de la feuille CRJ.
Voila j'espere avoir été clair.

Merci de votre aide
08/12/2014, 14h46
Daniel.C

Désolé, c'est moi qui me fait mal comprendre. Il y a deux façons de déclencher la copie. Soit en testant que toutes les cellules ont été remplies (mais il faut que toutes les cellules à copier soient obligatoirement remplies), soit on met un bouton pour déclencher la copie.
08/12/2014, 14h50
lovlov33

En fait suivant les incidents , toutes les cases ne seront pas remplies , donc je pense qu'un bouton ferait l'affaire

1 pièce(s) jointe(s)

J'ai mis un bouton "COPIE" sur la feuille "Suivi ROP" avec le code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub CommandButton2_Click()
    Dim Lig As Long, Ligne As Long
    With Sheets("CRJ")
        Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        If Ligne = 8 Then Ligne = 9
        Lig = [A:A].Find("n° train", , , xlWhole, xlByRows, xlPrevious).Row + 1
        .Cells(Ligne, 1) = Cells(Lig, 1)
        .Cells(Ligne, 6) = Cells(Lig, 2)
        .Cells(Ligne, 4) = Cells(Lig + 7, 2)
        .Cells(Ligne, 9) = Cells(Lig + 5, 11)
        .Cells(Ligne, 2) = Cells(Lig + 3, 1)
        .Cells(Ligne, 3) = Cells(Lig + 4, 1)
    End With
End Sub

Ci-joint le classeur : Pièce jointe 163340

09/12/2014, 11h32
lovlov33

Bonjour,

Je te remercie de ton aide, ta macro fonctionne impeccable. Le seul truc, je voudrais pouvoir copier tableau par tableau de la page suivi Rop( sachant que l'on peut avoir une trentraine de tableau, les uns sous les autres ) .
Donc en fait je voudrais pourvoir transferer mes données de tous les tableaux au fur et a mesure des incidents.
Encore merci pour ton aide
09/12/2014, 11h42
Daniel.C

Bonjour,

La macro copie toujours le dernier tableau créé. Je voudrais être sûr de bien comprendre avant de coder. Tu veux dire : je remplis 30 (par exemple) tableaux et je les copie en bloc ? Et si, ensuite, tu en ajoutes un autre, est-ce qu'il faut effacer la feuille CRJ et refaire la copie de tous les tableaux ?
09/12/2014, 14h16
lovlov33

Non , en fait je voudrais avoir un bouton qui me permette de copier les elements d'un tableau par rapport a son N° D'incident ( Case D/E à Coté de la case " Numéro d'incident").
Je ne veux pas une copie bloc mais bien a la demande.
merci beaucoup de ton aide

1 pièce(s) jointe(s)

J'ai ajouté un combobox pour le choix du tableau à copier. Ce combobox est rempli à l'ouverture du classeur et lorsque tu appuies sur le bouton "actualisation". La macro de ce bouton est :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub CommandButton1_Click()
    Dim C As Range, ResAdr As String
    With Sheets("Suivi ROP")
        .ComboBox1.Clear
        Set C = .Cells.Find("Numéro d'incident", , , xlWhole)
        If Not C Is Nothing Then
            ResAdr = C.Address
            Do
                If C.Column = 1 Then .ComboBox1.AddItem C.Offset(, 1).Value
                Set C = .Cells.FindNext(C)
            Loop Until C.Address = ResAdr
        End If
    End With
End Sub

Celle du bouton "Copie" est :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub CommandButton2_Click()
    Dim Lig As Long, Ligne As Long
    With Sheets("Suivi ROP")
        'recherche incident
        If .ComboBox1.ListIndex = -1 Then Exit Sub
        Lig = .[D:E].Find(.ComboBox1.Value, , , xlWhole).Row + 2
    End With
    With Sheets("CRJ")
        Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        If Ligne = 8 Then Ligne = 9
'        Lig = [A:A].Find("n° train", , , xlWhole, xlByRows, xlPrevious).Row + 1
        .Cells(Ligne, 1) = Cells(Lig, 1)
        .Cells(Ligne, 6) = Cells(Lig, 2)
        .Cells(Ligne, 4) = Cells(Lig + 7, 2)
        .Cells(Ligne, 9) = Cells(Lig + 5, 11)
        .Cells(Ligne, 2) = Cells(Lig + 3, 1)
        .Cells(Ligne, 3) = Cells(Lig + 4, 1)
    End With
End Sub

La macro remplissant le combobox à l'ouverture est :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Workbook_Open()
    Dim C As Range, ResAdr As String
    With Sheets("Suivi ROP")
        .ComboBox1.Clear
        Set C = .Cells.Find("Numéro d'incident", , , xlWhole)
        If Not C Is Nothing Then
            ResAdr = C.Address
            Do
                If C.Column = 1 Then .ComboBox1.AddItem C.Offset(, 1).Value
                Set C = .Cells.FindNext(C)
            Loop Until C.Address = ResAdr
        End If
    End With
End Sub

PJ : le classeur : Pièce jointe 163435

11/12/2014, 15h20
lovlov33

Bonjour,

je te remercie enormement de ton aide. Tes macros fonctionnent a merveille.
Puis je te demander une dernière faveur. J'aurais besoin de faire une copie lors de la cloture de l'incident du tableau correspondant dans une feuille archive(feuille à insérer)en plus de la copie que tu as deja crée. En fait je voudrais couper le tableau fini et le coller dans la feuille archive . Et cela a chaque tableau terminé.
Je te remercie beaucoup;)

Bonjour,

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Private Sub CommandButton2_Click()
    Dim Lig As Long, Ligne As Long, Plage As Range
    With Sheets("Suivi ROP")
        'recherche incident
        If .ComboBox1.ListIndex = -1 Then Exit Sub
        Lig = .[D:E].Find(.ComboBox1.Value, , , xlWhole).Row + 2
    End With
    With Sheets("CRJ")
        Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        If Ligne = 8 Then Ligne = 9
'        Lig = [A:A].Find("n° train", , , xlWhole, xlByRows, xlPrevious).Row + 1
        .Cells(Ligne, 1) = Cells(Lig, 1)
        .Cells(Ligne, 6) = Cells(Lig, 2)
        .Cells(Ligne, 4) = Cells(Lig + 7, 2)
        .Cells(Ligne, 9) = Cells(Lig + 5, 11)
        .Cells(Ligne, 2) = Cells(Lig + 3, 1)
        .Cells(Ligne, 3) = Cells(Lig + 4, 1)
    End With
    With Sheets("Suivi ROP")
        Lig = Lig - 2
        Set Plage = .Range(.Cells(Lig, 1), .Cells(Lig + 12, 12))
    End With
    With Sheets("Archive")
        Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row
        Plage.Copy .Cells(Ligne, 1)
    End With
End Sub