Discussion :

[TheFlow31]

Bonjour,

Je suis complètement novice sur le langage VBA, et malgré mes recherches sur les forum et livre, je ne trouve pas.

Dans mes feuilles nommées "Actions en cours" et "Actions en attente", j'ai un tableau avec plusieurs lignes et lorsque dans la colonne G, on trouve la valeur 1, je souhaiterai que certaines informations de la ligne soient copiées et collées dans une autre feuille nommée "Tableau de bord".
Par contre, lorsque l'on clique sur le bouton qui lance l'action VBA, les lignes qui ont été collées précédemment ne doivent pas être écrasées par les nouvelles lignes renseignées.

Pouvez-vous m'aider à écrire le code pour cette action ?


Dessous vous trouverez ce que j'ai commencé à faire mais j'ai une erreur

erreur d'exécution '13' - Incompatibilité de type

que je ne sais résoudre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Sub ACTUALISATION_DONNEES_TDB()
Dim i As Integer, j As Integer, Derlig As Integer
Dim Ligvid As Integer
Dim Tampon1 As Integer
Dim Tampon2 As Integer
Dim Tampon3 As Integer
Dim Tampon4 As Integer
Application.ScreenUpdating = False
'Lance la sub EFFACER pour purger le tableau avant compilation
EFFACER
For j = 4 To 5
    Sheets(j).Select
    Derlig = Sheets(j).Range("A" & Rows.Count).End(xlUp).Row
    For i = Derlig To 2 Step -1
        Sheets(j).Select
        If UCase(Range("G" & i)) = "1" Then
            'mémorisation de la plage à transfèrer
            Tampon1 = Sheets(j).Range("A" & i & ":A" & i)
            Tampon2 = Sheets(j).Range("C" & i & ":F" & i)
            Tampon3 = Sheets(j).Range("H" & i & ":J" & i)
            Tampon4 = Sheets(j).Range("L" & i & ":L" & i)
            'Tampon = Range(Cells(Lig, "A"), Cells(Lig, "L"))
            With Sheets("Tableau de bord")
            '1° ligne vide
            Ligvid = .Columns("A").Find("", .Range("A1")).Row
            'écriture de la plage
            With .Range(.Cells(Ligvid, "A"))
            .Value = Tampon1
            'écriture de la plage
            With .Range(.Cells(Ligvid, "B"), .Cells(Ligvid, "E"))
            .Value = Tampon2
            'écriture de la plage
            With .Range(.Cells(Ligvid, "F"), .Cells(Ligvid, "H"))
            .Value = Tampon3
            'écriture de la plage
            With .Range(.Cells(Ligvid, "I"))
            .Value = Tampon4
            End With
            End With
            End With
            End With
            End With
        End If
    Next
Next
Sheets("Tableau de bord").Activate
End Sub

[Invité]

Bonjour,

A tester :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
28
29
30
31
32
33
34
Sub Actualisation_Donnees_TDB()
 
   ' Application.ScreenUpdating = False
    'Lance la sub EFFACER pour purger le tableau avant compilation
    'EFFACER
 
    TransfererDonnees Sheets("Actions en cours"), Sheets("Tableau de bord")
    TransfererDonnees Sheets("Actions en attente"), Sheets("Tableau de bord")
    Sheets("Tableau de bord").Activate
    ' Application.ScreenUpdating = True
 
End Sub
 
Sub TransfererDonnees(ByVal ShActions As Worksheet, ByVal ShTableauDeBord As Worksheet)
 
Dim I As Long, Derlig As Long, Ligvid As Long
 
    With ShActions
         Derlig = .Cells(.Rows.Count, 1).End(xlUp).Row
         For I = Derlig To 2 Step -1
             If .Range("G" & I) = 1 Then
 
                Ligvid = ShTableauDeBord.Cells(.Rows.Count, 1).End(xlUp).Row + 1
 
                .Range("A" & I).Copy Destination:=ShTableauDeBord.Cells(Ligvid, 1)
                .Range("C" & I & ":F" & I).Copy Destination:=ShTableauDeBord.Cells(Ligvid, 2)
                .Range("H" & I & ":J" & I).Copy Destination:=ShTableauDeBord.Cells(Ligvid, 6)
                .Range("L" & I & ":L" & I).Copy Destination:=ShTableauDeBord.Cells(Ligvid, 9)
 
             End If
        Next I
    End With
 
End Sub

[TheFlow31]

Bonjour Eric,

J'ai essayé le code mais cela ne marche pas tout à fait comme je le souhaite. J'ai donc mis en PJ le plan d'action pour visualisation du résultat obtenu.

Le problème est que les actions se compilent en dehors du tableau déclaré. J'ai déjà été face à ce problème et ne sait le résoudre...

en espérant que vous sauriez m'aider.

[Invité]

C'est normal, votre tableau est un tableau structuré. Les procédures doivent être placées dans un module standard.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
28
29
30
31
32
33
34
35
36
 
Option Explicit
 
Sub Actualisation_Donnees_TDB()
 
   ' Application.ScreenUpdating = False
    'Lance la sub EFFACER pour purger le tableau avant compilation
    'EFFACER
 
    TransfererDonnees Sheets("Actions En Cours"), Sheets("Tableau de bord").ListObjects("Données_TDB")
    TransfererDonnees Sheets("Actions En Attente"), Sheets("Tableau de bord").ListObjects("Données_TDB")
    Sheets("Tableau de bord").Activate
    ' Application.ScreenUpdating = True
 
End Sub
 
Sub TransfererDonnees(ByVal ShActions As Worksheet, ByVal TableauDeBord As ListObject)
 
Dim I As Long, Derlig As Long
Dim NouvelleLigne As ListRow
 
    With ShActions
         Derlig = .Cells(.Rows.Count, 1).End(xlUp).Row
         For I = Derlig To 2 Step -1
             If .Range("G" & I) = 1 Then
                Set NouvelleLigne = TableauDeBord.ListRows.Add
                .Range("A" & I).Copy Destination:=NouvelleLigne.Range(1, 1)
                .Range("C" & I & ":F" & I).Copy Destination:=NouvelleLigne.Range(1, 2)
                .Range("H" & I & ":J" & I).Copy Destination:=NouvelleLigne.Range(1, 6)
                .Range("L" & I & ":L" & I).Copy Destination:=NouvelleLigne.Range(1, 9)
                Set NouvelleLigne = Nothing
             End If
        Next I
    End With
 
End Sub

[TheFlow31]

Bonjour Eric,

La macro fonctionne parfaitement.

Merci pour votre coup de pouce!