Discussion :

[RastaBomboclat]

Bonjour la communauté,

Je reviens avec un problème qui nécessitera, je pense, une bonne maitrise de la notion des boucles et tableaux. Parce que j’ai essayé de le faire avec les fonctions d’Excel telles que Lookup et VLookup, mais ça n’a pas marché. Voilà pourquoi je me tourne vers les macros.

Au fait, j’aimerai transferer des données d'une tableau(initial) vers un autre(final). Sauf que le tableau final est fixe alors que le tableau initial ne n'est pas. Sur mon tableau initial, la colonne A peut avoir pour le premier sous-total de 3 a 15 lignes de donnée. Alors que dans le tableau final(dans la feuille "Format Final") il y a 15 Colonnes prédefinies qui doivent etre remplies avec les données du tableau initial(qui se trouve dans sur la 1ere feuille "Format Initail").
Pour mieux me faire comprendre je joints un fichier pour mieux illuster la situation.

P.S.: Messieurs les Administrateur du groupe, j'ai en effet une autre question en attente sur un autre post, qui n'est pas encore completement resolu. Je post celle-ci parce que c'est un autre problème auquel je fais face et que je souhaiterai vraiment resoudre avant Noël, voila pourquoi, messieurs les Administrateurs du groupe, je vous pries de ne pas bloquer ce post, mais au contraire d'y contribuer avec une belle solution

Merci à tous pour vos contribution.

Rasta Bomboclat

[Theze]

Bonjour,

Un truc dans le genre ?

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
48
49
50
51
52
53
 
Sub Test()
 
    Dim Plage As Range
    Dim Cel As Range
    Dim Tbl()
    Dim TblDonnees
    Dim I As Integer
    Dim J As Integer
 
    With Worksheets("Format Initial")
 
        Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
 
    End With
 
    'titres des colonnes
    TblDonnees = Array("Donnée_1", "Donnée_2", "Donnée_3", "Donnée_4", "Donnée_5", _
                       "Donnée_6", "Donnée_7", "Donnée_8", "Donnée_9", "Donnée_10", _
                       "Donnée_11", "Donnée_12", "Donnée_13", "Donnée_14", "Donnée_15")
 
    'défini le nombre de lignes du tableau (+ 1 = ligne des titres)
    I = Application.CountIf(Plage, "Total_Données") + 1
 
    'les bornes étant connues, dimensionne le tableau
    ReDim Tbl(1 To I, 1 To UBound(TblDonnees) + 1)
 
    'rempli la première ligne (titres)
    For I = 1 To UBound(TblDonnees) + 1: Tbl(1, I) = TblDonnees(I - 1): Next I
 
    'évite la ligne des titres
    I = 2
 
    For Each Cel In Plage
 
        If Cel.Value <> "Total_Données" Then
 
            'récupère la valeur de la cellule en colonne B (à adapter, Débit=1 ou Crédit=2)
            Tbl(I, Application.Match(Cel.Value, TblDonnees, 0)) = Cel.Offset(, 1).Value
 
        Else
 
            'ligne suivante
            I = I + 1
 
        End If
 
    Next Cel
 
    'colle le tableau dans la feuille
    With Worksheets("Format Final"): .Range(.Cells(1, 1), .Cells(UBound(Tbl, 1), UBound(Tbl, 2))).Value = Tbl: End With
 
End Sub

[RastaBomboclat]

C'est vraiment Noël!!!
J'ai une réponse en moins de 12h. J'ai dû vraiment assurer cette année; le père Noël viendra, je crois.

Merci Theze!, je l'essaie tout de suite...

Rasta Bomboclat

Merci encore pour ton code Theze.

Il fonctionne mais a moitié. C'est-à-dire que quand la partie Débit fonctionne, la partie Crédit ne fonctionne pas, et vis-vers-ça.
j'ai vu dans le code un commentaire "à adapter", mais mes adaptation ne marchent pas.

Pourrais-tu, s'il te plaît, essayer de trouver une adaptation qui puisse faire fonctionner les deux colonnes (Débít et Crédit)?

Merci a tous pour votre contribution et participation.

Rasta Bomboclat

[Theze]

Tu veux récupérer les deux valeurs (Débit et Crédit), si c'est le cas, il te faut 2 tableaux ou alors, concaténer les deux valeurs dans la même cellule mais dans ce cas, il te sera plus difficile d'effectuer des calculs !

dans l'hypothèse où tu veux récupérer les deux valeurs, elles seront dans deux tableaux différents :

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Sub Test()
 
    Dim Plage As Range
    Dim Cel As Range
    Dim TblDebit()
    Dim TblCredit()
    Dim TblDonnees
    Dim I As Integer
    Dim J As Integer
 
    With Worksheets("Format Initial")
 
        Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
 
    End With
 
    'titres des colonnes
    TblDonnees = Array("Donnée_1", "Donnée_2", "Donnée_3", "Donnée_4", "Donnée_5", _
                       "Donnée_6", "Donnée_7", "Donnée_8", "Donnée_9", "Donnée_10", _
                       "Donnée_11", "Donnée_12", "Donnée_13", "Donnée_14", "Donnée_15")
 
    'défini le nombre de lignes du tableau (+ 1 = ligne des titres)
    I = Application.CountIf(Plage, "Total_Données") + 1
 
    'les bornes étant connues, dimensionne les tableaux
    ReDim TblDebit(1 To I, 1 To UBound(TblDonnees) + 1)
    ReDim TblCredit(1 To I, 1 To UBound(TblDonnees) + 1)
 
    'rempli la première ligne de chaque tableau (les titres)
    For I = 1 To UBound(TblDonnees) + 1: TblDebit(1, I) = TblDonnees(I - 1): Next I
    For I = 1 To UBound(TblDonnees) + 1: TblCredit(1, I) = TblDonnees(I - 1): Next I
 
    'évite la ligne des titres
    I = 2
 
    For Each Cel In Plage
 
        If Cel.Value <> "Total_Données" Then
 
            'récupère la valeur de la cellule en colonne B (débit) et C (crédit)
            J = Application.Match(Cel.Value, TblDonnees, 0) 'pour positionner les valeurs dans les tableaux
            TblDebit(I, J) = Cel.Offset(, 1).Value
            TblCredit(I, J) = IIf(J = 1, Cel.Offset(, 1).Value, Cel.Offset(, 2).Value)
 
        Else
 
            'ligne suivante
            I = I + 1
 
        End If
 
    Next Cel
 
    'colle le tableau dans la feuille
    With Worksheets("Feuil1") '"Format Final")
 
        .Cells(1, 1).Value = "Tableau Débit"
        .Range(.Cells(2, 1), .Cells(UBound(TblDebit, 1) + 1, UBound(TblDebit, 2))).Value = TblDebit
 
        .Cells(UBound(TblDebit, 1) + 2, 1).Value = "Tableau Crédit"
        .Range(.Cells(UBound(TblCredit, 1) + 3, 1), .Cells(UBound(TblCredit, 1) * 2 + 2, UBound(TblCredit, 2))).Value = TblCredit
 
    End With
 
End Sub

[RastaBomboclat]

Merci Theze pour ton retour rapide et aussi ton code.
Je le teste tout de suite.

Entretemps, je voulais rappeler que le but pour moi est d’obtenir dans le format que j’utilise, les infos reçu d’un autre département. Il me les envois en brut comme dans la feuille « Format Initial », et moi je voudrai les mettre dans le format que j’utilise et ainsi terminer mon travail. Sauf que quand les données font plus de 5000 ligne, les faire une à une n’est pas du tout pratique. Donc pour moi Il ne suffit que je puis transposer le fichier (Format Initial) que je reçois de mon collègue dans mon format (Format Final), et pour le reste je pourrai facilement me débrouiller.

Il y a des Données (Donnée_1 ; Donnée_2 ; Donnée_3 ; …) qui sont toujours au débit et d’autres (Donnée_10, Donnée_11 ; Donnée_12 ; …) qui sont toujours au Crédit. Si je les identifiais une a une, peut-être que ça simplifierai les choses ?

• Débit (Donnée_1 à Donnée_9)
• Crédit (Donnée_10 à Donnée_15)

Merci à tout le monde pour la contribution et participation.

Rasta Bomboclat

[Theze]

Il y a des Données (Donnée_1 ; Donnée_2 ; Donnée_3 ; …) qui sont toujours au débit et d’autres (Donnée_10, Donnée_11 ; Donnée_12 ; …) qui sont toujours au Crédit. Si je les identifiais une a une, peut-être que ça simplifierai les choses ?

A moins que tu ais un compilateur devin, je pense qu'il serait préférable des les identifier les unes par rapport aux autres !

[RastaBomboclat]

Merci Theze, il fonctionne bien, et en principe je devrais me caller sur ce dernier code, et mettre une petite formule Excel pour regrouper les deux tableaux en un seul, puisque le plus gros a été fait. Mais je décelé une omission de ma part. Je l'explique plus bas.

P.S.:
Dans le code sur la ligne 56, il y a eu une erreur que j’ai corrigée.

Code :

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

 With Worksheets("Feuil1") '"Format Final")

Je l’ai remplacer d’abord par:

Code :

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

 With Worksheets("1") '"Format Final")

Ce qui m’a mis la réponse attend sur ma feuille “Format Initial”, puis j’ai corrigé avec

Code :

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

With Worksheets("2") '"Format Final")

Ce qui m’a résolu la petite erreur.

Quand j'ai essayer finalment de l'appliquer sur mon fichier de travail, une erreur a été generé.
Je viens de me rendre compte que la « Donnée_1 » est variable, puisqu’étant un code employé (tel que DA1234 ou LU1234). C’est le seul problème qui reste. Comme les code employés changent pour chaque employé, on ne peut plus declarer dans le TblDonnes "Données_1". Vraiment désolé pour ce gros oubli. Il y a-t-il moyen d'y remedier ?

j'ai joint le fichier ci-dessous.

Merci à tout le monde pour la contribution et participation.

Rasta Bomboclat

[RastaBomboclat]

Bonjour Theze,
Bonjour la communauté,

Il y a-t-il quelqu’un qui a pu trouver une solution à mon problème ?
Le problème est presque résolu, il ne reste plus qu’à trouver comment insérer la donnée variable dans le tableau.

Merci d’avance toute la communauté.

Rasta Bomboclat.

[Theze]

Bonjour,

Le problème vient du fait que tu ne donne pas toutes les infos dès le début alors on passe du temps pour te donner une solution qu'il faut ensuite reprendre de fond en combles car arrive au compte gouttes d'autres infos !
Tu dis que la valeur "Donnée_1" est variable donc, comment veux-tu qu'elle apparaisse, concaténée au nom car sur un seul tableau, elle ne peut pas se trouver en entête de colonne. Ou alors, dans un champ supplémentaire où l'entête de colonne reste "Donnée_1" pour les nom et "Code" ou Donnée_0" pour le code employés !

Je t'ai pondu un nouveau code regardes le résultat. J'ai rajouté un champ nommé "Donnée_0" qui contient le code employé, le champ "Donnée_1" le nom et j'ai modifié pour récupérer les débits et crédits. Les crédits sont récupérés si le champ "Débit" est égal à 0 :

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
Sub Test()
 
    Dim Plage As Range
    Dim Cel As Range
    Dim TblDebit()
    Dim TblDonnees
    Dim I As Integer
    Dim J As Integer
 
    With Worksheets("Format Initial")
 
        Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
 
    End With
 
    'titres des colonnes
    TblDonnees = Array("Donnée_0", "Donnée_1", "Donnée_2", "Donnée_3", "Donnée_4", "Donnée_5", _
                       "Donnée_6", "Donnée_7", "Donnée_8", "Donnée_9", "Donnée_10", _
                       "Donnée_11", "Donnée_12", "Donnée_13", "Donnée_14", "Donnée_15")
 
    'défini le nombre de lignes du tableau (+ 1 = ligne des titres)
    I = Application.CountIf(Plage, "Total_Données") + 1
 
    'les bornes étant connues, dimensionne le tableau
    ReDim TblDebit(1 To I, 1 To UBound(TblDonnees) + 1)
 
    'rempli la première ligne de chaque tableau (les titres)
    For I = 1 To UBound(TblDonnees) + 1
 
        TblDebit(1, I) = TblDonnees(I - 1)
 
    Next I
 
    'évite la ligne des titres
    I = 2
 
    For Each Cel In Plage
 
        If Cel.Value <> "Total_Données" Then
 
            'récupère la valeur de la cellule en colonne B (débit) et C (crédit)...
 
            'pour positionner les valeurs dans le tableau.
            On Error Resume Next
            J = Application.Match(Cel.Value, TblDonnees, 0)
 
            'Une erreur est générée si la valeur n'est pas dans le tableau
            If Err.Number <> 0 Then
 
                J = 1
                TblDebit(I, 1) = Cel.Value
                TblDebit(I, 2) = Cel.Offset(, 1).Value
 
             Else 'si pas d'erreur
 
                'si la valeur est zéro, ce n'est pas un débit mais un crédit
                'alors, récupère la valeur du crédit dans la colonne C
                If Cel.Offset(, 1).Value = 0 Then
 
                    TblDebit(I, J) = Cel.Offset(, 2).Value
 
                Else
 
                    TblDebit(I, J) = Cel.Offset(, 1).Value
 
                End If
 
            End If
 
            'annule le gestionnaire
            On Error GoTo 0
 
        Else
 
            'ligne suivante
            I = I + 1
 
        End If
 
    Next Cel
 
    'colle le tableau dans la feuille
    With Worksheets("Format Final")
 
        .Range(.Cells(1, 1), .Cells(UBound(TblDebit, 1), UBound(TblDebit, 2))).Value = TblDebit
 
    End With
 
End Sub

[RastaBomboclat]

Theze,
Ta question a presque résolu mon problème. Tu as bien raison, et après avoir vu, où et comment placer cette valeur de Donnée_1, avec mes collègues nous avons décider d’utiliser cette valeur comme valeur fixe qui pourra facilement être retrouvé avec un vlookup dans la feuille Format Final(avec toutes les infos qu’il y aura, se sera du tic au tac).
Je vais terminer mes testes avec des infos plus volumineuse (1000 lignes), avant de revenir valider en cliquant sur Résolu.
Merci encore de m’avoir éclairé.

Theze,

Je te répondais pendant que tu me renvoyais un nouveau code. Je ne l’avais pas vue. Merci. Je le teste tout de suite et reviens aussitôt te dire quoi.

Rasta Bomboclat

Re bonjour Theze.

Je voulais demander encore une petite chose.
Non, je blague. je suis très content. C'est vraiment Noël! Joyeux Noël a toi et toute la communauté de DEVELOPPEZ.NET

Merci beaucoup pour ta patience et pour ton code, surtout ce dernier, il fonctionne a Merveille!!! Trop cool

Cas RÉSOLU!

Rasta Bomboclat

[Klin89]

Bonsoir Theze, RastaBomboclat, le forum

Dans ton cas, on pourrait employer la méthode ColumnDifferences sur la colonne A et parcourir ainsi chaque zone.

Sinon ici, j'utilise la méthode SpecialCells sur la colonne B :
Restitution en Feuil1.

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
48
49
50
Option Explicit
 
Sub test()
Dim myAreas As Areas, r As Range, i As Long, t As Long, x, y
Dim tablo
    Application.ScreenUpdating = False
    ReDim tablo(1 To 1)
    Set myAreas = Sheets("Format Initial").Columns(2).SpecialCells(2, 1).Areas
    With Sheets("Feuil1")
        For i = 1 To myAreas.Count
            .Cells(i + 1, 1).Value = myAreas(i).Cells(0).Offset(, -1).Value
            .Cells(i + 1, 2).Value = myAreas(i).Cells(0).Value
            t = 2
            For Each r In myAreas(i)
                y = Application.Match(r.Offset(, -1).Value, tablo, 0)
                If IsError(y) Then
                    t = t + 1
                    .Cells(1, t).Value = r.Offset(, -1).Value
                    ReDim Preserve tablo(1 To t)
                    tablo(t) = r.Offset(, -1).Value
                    y = t
                End If
                If r.Offset(, 1).Value <> 0 Then
                    .Cells(i + 1, y).Value = r.Offset(, 1).Value
                Else
                    .Cells(i + 1, y).Value = r.Value
                End If
            Next
        Next
        With .Cells(1).CurrentRegion
            With .Rows(1)
                With .Offset(, 2).Resize(, .Columns.Count - 2)
                    .Font.Size = 11
                    .Interior.ColorIndex = 43
                    .Borders(xlInsideVertical).Weight = xlThin
                    .BorderAround Weight:=xlThin
                End With
            End With
            With .Offset(1).Resize(.Rows.Count - 1)
                .Borders(xlInsideVertical).Weight = xlThin
                .BorderAround Weight:=xlThin
            End With
            .Font.Name = "calibri"
            .VerticalAlignment = xlCenter
            .Columns.AutoFit
        End With
        .Parent.Activate
    End With
    Application.ScreenUpdating = True
End Sub

klin89

Bonsoir et bon Noël à tous

Avec la méthode ColumnDifferences, c'est plus judicieux.

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Option Explicit
 
Sub test()
Dim myAreas As Areas, i As Long, j As Long, t As Long, y
Dim tablo
    Application.ScreenUpdating = False
    ReDim tablo(1 To 1)
    With Sheets("Format Initial")
        With .Range("a2", .Range("a" & Rows.Count).End(xlUp))
            On Error Resume Next
            '.ColumnDifferences(.Find("Total_Données", lookat:=xlWhole)).Select
            Set myAreas = .ColumnDifferences(.Find("Total_Données", lookat:=xlWhole)).Areas
            On Error GoTo 0
        End With
    End With
    If myAreas Is Nothing Then Exit Sub
    'Restitution
    With Sheets("Feuil1")
        For i = 1 To myAreas.Count
            For j = 1 To myAreas(i).Rows.Count
                If j = 1 Then
                    .Cells(i + 1, 1).Value = myAreas(i).Cells(j).Offset(, 1).Value
                    .Cells(i + 1, 2).Value = myAreas(i).Cells(j).Value
                Else
                    y = Application.Match(myAreas(i).Cells(j).Value, tablo, 0)
                    If IsError(y) Then
                        t = t + 1
                        .Cells(1, t + 2).Value = myAreas(i).Cells(j).Value
                        ReDim Preserve tablo(1 To t)
                        tablo(t) = myAreas(i).Cells(j).Value
                        y = t
                    End If
                    If myAreas(i).Cells(j).Offset(, 2).Value <> 0 Then
                        .Cells(i + 1, y + 2).Value = myAreas(i).Cells(j).Offset(, 2).Value
                    Else
                        .Cells(i + 1, y + 2).Value = myAreas(i).Cells(j).Offset(, 1).Value
                    End If
                End If
            Next
        Next
        Set myAreas = Nothing
        With .Cells(1).CurrentRegion
            With .Rows(1)
                With .Offset(, 2).Resize(, .Columns.Count - 2)
                    .Font.Size = 11
                    .Interior.ColorIndex = 43
                    .Borders(xlInsideVertical).Weight = xlThin
                    .BorderAround Weight:=xlThin
                End With
            End With
            With .Offset(1).Resize(.Rows.Count - 1)
                .Borders(xlInsideVertical).Weight = xlThin
                .BorderAround Weight:=xlThin
            End With
            .Font.Name = "calibri"
            .VerticalAlignment = xlCenter
            .Columns.AutoFit
        End With
        .Parent.Activate
    End With
    Application.ScreenUpdating = True
End Sub

Bonne soirée à tous
klin89

[RastaBomboclat]

Bonsoir Klin89,

Merci pour ton code, mieux vaut tard que jamais, dit-on. Et en plus c'est une nouvelle possibilité, que j'ai vraiment envie de tester, même suis le code de Theze fonctionne bien, "l'abondance de bien ne nuis pas..."

Merci à toute la communauté pour toute l'aide et le soutient.

Rasta Bomboclat

Bonjour Klin89,

Ton code fonction à merveille, avec les couleurs et les autres format, je n'y avais pas enconre pensé, tellement j'étais sous préssions pour faire fonctionner ma macro.

Grand à vous deux THEZE et KLIN89, qui m'avez fourni de le resultat que je cherchais. Merci encore.

La je vais ouvrir une nouvelle discution pour demander comment créer un bouton dans la barre de menu. En effet toutes les solutions que j'ai pu trouver sur msdn.microsoft.com ne fontionne pas.

Rasta Bomboclat

Bonjour à tous,

Je reviens avec le code que THEZE et KLIN89 m’ont aidé à avoir et je souhaiterai y apporter quelques modification pour que la macro puisse organiser le tableau.

Au fait, le code fonctionne à merveille, mais il m’a été demandé d’organiser le tableau généré en débit et crédit. C’est-à-dire, que dans le tableau, après les deux première colonnes (de Noms et Code Fonctionnaire) viennent les colonnes des données de débit, et après viendront les colonnes des données de crédit. Cela permettra à ce que l'on puisse facilement rajouter deux nouvelles colonnes à la fin du tableau (Total Débit et Total Crédit).

Ma difficulté se trouve au niveau entre les lignes 49 et 86. Mais si le reste du code peut etre optimiser, merci encore…

Merci à vous tous qui contribuez.

Rasta Bomboclat

voici le code:

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
Option Explicit
 
Sub PayrollConvert()
Dim myAreas As Areas, I As Long, J As Long, t As Long, y, c
Dim r As Integer, s As Integer
Dim tablo, DerniereLigne
 
'Nommer la feuil premiere feuil
    Worksheets(1).Name = "Format Initial"
 
'Formate la feuille en ajustant la taille des colonne, en mettant un filtre de colonne et un freeze pane
    Columns("A:D").Select
    Selection.EntireColumn.AutoFit
    Rows("2:2").Select
    ActiveWindow.FreezePanes = True
    Range("A1:C1").Select
    Selection.AutoFilter
    Range("A1").Select
 
'Crée une nouvelle feuil en dernière position et la nomme, puis retourne à la première feuil
    On Error Resume Next
    Err = 0
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "Format Final"
    If Err <> 0 Then
        Application.DisplayAlerts = False
        ActiveSheet.Delete        'détruit la feuille créée
        Application.DisplayAlerts = True
        MsgBox Application.UserName & "," & vbCr & "A folha" & vbCr & "Format Final" & vbCr & "já exist. Deves recomeçar o processo." & vbCr & "Lamentamos", vbCritical, "Interupção do processo!"
        Exit Sub
    End If
 
'Effacer les lignes des cellules vide de la colonne A.
    Worksheets(1).Select
    For Each c In Worksheets(1).Range("A1:A" & Range("A65356").End(xlUp).Row)
        If c = "" Then c.EntireRow.Delete
    Next c
'Effacer les ligne de l'About System
    DerniereLigne = Worksheets(1).UsedRange.Rows.Count
        For r = DerniereLigne To 1 Step -1
            If Cells(r, 1) Like "*© PRIMAVERA*" Then Rows(r).Delete
        Next r
'
        For s = DerniereLigne To 1 Step -1
            If Cells(s, 1) Like "*global em*" Then Rows(s).Delete
        Next s
 
'Début du processus de conversion et transposition
Application.ScreenUpdating = False
 
    ReDim tablo(1 To 1)
    With Sheets("Format Initial")
        With .Range("a2", .Range("a" & Rows.Count).End(xlUp))
            On Error Resume Next
            '.ColumnDifferences(.Find("Total Funcionário", lookat:=xlWhole)).Select
            Set myAreas = .ColumnDifferences(.Find("Total Funcionário", lookat:=xlWhole)).Areas
            On Error GoTo 0
        End With
    End With
    If myAreas Is Nothing Then Exit Sub
    'Restitution
    With Sheets("Format Final")
        For I = 1 To myAreas.Count
            For J = 1 To myAreas(I).Rows.Count
                If J = 1 Then
                    .Cells(I + 1, 1).Value = myAreas(I).Cells(J).Offset(, 1).Value
                    .Cells(I + 1, 2).Value = myAreas(I).Cells(J).Value
                Else
                    y = Application.Match(myAreas(I).Cells(J).Value, tablo, 0)
                    If IsError(y) Then
                        t = t + 1
                        .Cells(1, t + 2).Value = myAreas(I).Cells(J).Value
                        ReDim Preserve tablo(1 To t)
                        tablo(t) = myAreas(I).Cells(J).Value
                        y = t
                    End If
                    If myAreas(I).Cells(J).Offset(, 2).Value <> 0 Then
                        .Cells(I + 1, y + 2).Value = myAreas(I).Cells(J).Offset(, 2).Value
                    Else
                        .Cells(I + 1, y + 2).Value = myAreas(I).Cells(J).Offset(, 1).Value
                    End If
                End If
            Next
        Next
 
        Set myAreas = Nothing
        With .Cells(1).CurrentRegion
            With .Rows(1)
                With .Offset(, 2).Resize(, .Columns.Count - 2)
                    .Font.Size = 11
                    .Interior.ColorIndex = 43
                    .Borders(xlInsideVertical).Weight = xlThin
                    .BorderAround Weight:=xlThin
                End With
            End With
            With .Offset(1).Resize(.Rows.Count - 1)
            .Font.Name = "calibri"
            .VerticalAlignment = xlCenter
            .Columns.AutoFit
        End With
        .Parent.Activate
    End With
 
End With
 
'Formatage des cellules.
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Nome do Funcionario"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Cgo.Funcionario"
    Range("C1").Select
    Selection.Copy
    Range("A1:B1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("C:C").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Style = "Comma"
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.EntireColumn.AutoFit
    Columns("B:B").Select
    Columns("B:B").EntireColumn.AutoFit
    Rows("2:2").Select
    ActiveWindow.FreezePanes = True
    Range("A1").Select
 
'Message de confirmation de processus réussi.
    If MsgBox(Application.UserName & "," & vbCr & "A converção foi feita com successo." & vbCr & "Parabenz!" & vbCr & vbCr & "Deseja ir para a folha FORMAT FINAL ?", vbInformation + vbYesNo) = vbYes Then
        Worksheets("Format Final").Activate
        Worksheets("Format Final").Range("A1").Select
 
    Else: Worksheets("Format Initial").Activate
        Worksheets("Format Initial").Range("A1").Select
 
    End If
 
Application.ScreenUpdating = True
 
'Fin et sortie de la macro.
End Sub

[Theze]

Bonjour,

Avec deux tableaux (Crédits et Débits) et une mise en forme (sera supprimée et recréé à chaque lancement) :

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
 
Sub Test()
 
    Dim Plage As Range
    Dim Cel As Range
    Dim TblDebit()
    Dim TblCredit()
    Dim TblDonnees
    Dim I As Integer
    Dim J As Integer
    Dim Lgn As Long
 
    'vide la feuille de toutes données et supprime toutes mises en forme
    With Worksheets("Format Final").Cells
 
        .Clear
 
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
 
        .UnMerge
 
        .FormatConditions.Delete
 
        .Font.Bold = False
 
    End With
 
    'défini la plage
    With Worksheets("Format Initial")
 
        Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
 
    End With
 
    'titres des colonnes
    TblDonnees = Array("Code", "Nom", "Total", "Donnée_2", "Donnée_3", "Donnée_4", "Donnée_5", _
                       "Donnée_6", "Donnée_7", "Donnée_8", "Donnée_9", "Donnée_10", _
                       "Donnée_11", "Donnée_12", "Donnée_13", "Donnée_14", "Donnée_15")
 
    'défini le nombre de lignes du tableau (+ 1 = ligne des titres)
    I = Application.CountIf(Plage, "Total_Données") + 1
 
    'les bornes étant connues, dimensionne les tableaux
    ReDim TblDebit(1 To I, 1 To UBound(TblDonnees) + 1)
    ReDim TblCredit(1 To I, 1 To UBound(TblDonnees) + 1)
 
    'rempli la première ligne de chaque tableau (les titres)
    For I = 1 To UBound(TblDonnees) + 1
 
        Select Case TblDonnees(I - 1)
 
            Case "Total"
                TblDebit(1, I) = "Total Débit"
                TblCredit(1, I) = "Total Crédit"
 
            Case Else
                TblDebit(1, I) = TblDonnees(I - 1)
                TblCredit(1, I) = TblDonnees(I - 1)
 
        End Select
 
    Next I
 
    'évite la ligne des titres
    I = 2
 
    For Each Cel In Plage
 
        If Cel.Value <> "Total_Données" Then
 
            'récupère la valeur de la cellule en colonne B (débit) et C (crédit)
            On Error Resume Next
            J = Application.Match(Cel.Value, TblDonnees, 0) 'pour positionner les valeurs dans les tableaux
 
            If Err.Number <> 0 Then
 
                J = 1
                TblDebit(I, 1) = Cel.Value
                TblDebit(I, 2) = Cel.Offset(, 1).Value
 
                TblCredit(I, 1) = Cel.Value
                TblCredit(I, 2) = Cel.Offset(, 1).Value
 
             Else
 
                'si la valeur est zéro, ce n'est pas un débit mais un crédit
                'alors, récupère la valeur du crédit dans la colonne C
                If Cel.Offset(, 1).Value = 0 Then
 
                    TblDebit(I, J) = Cel.Offset(, 2).Value
 
                Else
 
                    TblCredit(I, J) = Cel.Offset(, 1).Value
 
                End If
 
            End If
 
            On Error GoTo 0
 
        Else
 
            'ligne suivante
            I = I + 1
 
        End If
 
    Next Cel
 
    'récupère le nombre de lignes
    I = Application.CountIf(Plage, "Total_Données")
 
    'colle le tableau dans la feuille
    With Worksheets("Format Final")
 
'************************************************
'*           Tableau des débits                 *
'************************************************
 
        'fusionne
        .Range(.Cells(2, 1), Cells(2, UBound(TblDebit, 2))).Merge
 
        'en défini la valeur et formate
        With .Cells(2, 1)
 
            .Value = "TABLEAU DEBIT"
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Font.Bold = True
            .Interior.Color = 8564980
 
        End With
 
        'les titres en gras et fond en couleur
        With .Range(.Cells(3, 1), .Cells(3, UBound(TblDebit, 2)))
 
            .Font.Bold = True
            .Interior.Color = 49407
 
        End With
 
        'cadrillage
        With .Range(.Cells(2, 1), .Cells(UBound(TblDebit, 1) + 2, UBound(TblDebit, 2)))
 
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlInsideHorizontal).LineStyle = xlContinuous
 
        End With
 
        'MFC pour colorer une ligne non l'autre
        With .Range(.Cells(3, 1), .Cells(UBound(TblDebit, 1) + 2, UBound(TblDebit, 2)))
 
            .FormatConditions.Add 2, , "=MOD(LIGNE();2)=0"
            .FormatConditions(1).Interior.Color = 10086399
 
        End With
 
        'colle les valeurs
        .Range(.Cells(3, 1), .Cells(UBound(TblDebit, 1) + 2, UBound(TblDebit, 2))).Value = TblDebit
 
        'ajoute les formule de sommage
        .Cells(4, 3).Formula = "=SUM(D4:Q4)": .Cells(4, 3).AutoFill .Range(.Cells(4, 3), .Cells(I + 3, 3))
 
'************************************************
'*          Tableau des crédits                 *
'************************************************
 
        Lgn = .Cells(.Rows.Count, 1).End(xlUp).Row + 2
 
        .Range(.Cells(Lgn, 1), Cells(Lgn, UBound(TblDebit, 2))).Merge
 
        With .Cells(Lgn, 1)
 
            .Value = "TABLEAU CREDIT"
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Font.Bold = True
            .Interior.Color = 8564980
 
        End With
 
        With .Range(.Cells(Lgn + 1, 1), .Cells(Lgn + 1, UBound(TblCredit, 2)))
 
            .Font.Bold = True
            .Interior.Color = 49407
 
        End With
 
        With .Range(.Cells(Lgn + 1, 1), .Cells(UBound(TblCredit, 1) + Lgn, UBound(TblCredit, 2)))
 
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlInsideHorizontal).LineStyle = xlContinuous
 
        End With
 
        With .Range(.Cells(Lgn + 2, 1), .Cells(UBound(TblCredit, 1) + Lgn, UBound(TblCredit, 2)))
 
            .FormatConditions.Add 2, , "=MOD(LIGNE();2)=0"
            .FormatConditions(1).Interior.Color = 10086399
 
        End With
 
 
        .Range(.Cells(Lgn + 1, 1), .Cells(UBound(TblCredit, 1) + Lgn, UBound(TblCredit, 2))).Value = TblCredit
 
        .Cells(Lgn + 2, 3).Formula = "=SUM(D" & Lgn + 2 & ":Q" & Lgn + 2 & ")": .Cells(Lgn + 2, 3).AutoFill .Range(.Cells(Lgn + 2, 3), .Cells(Lgn + I + 1, 3))
 
    End With
 
End Sub

[RastaBomboclat]

Bonjour,

Je n'annexe le fichier pour mieux illustrer ce que je souhaite faire (obtenir).

Merci à tous

[Marc-L]

D'après le classeur joint dans le post précédent :

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
Sub Demo1()
                                        Const DN1 = "Donnée_1"
    With Feuil1.UsedRange
        L& = Application.CountIf(.Columns(1), DN1)
        VA = .Value
    End With
    With Feuil2.UsedRange.Rows
        NC = .Item(1).Value
        C& = .Columns.Count
        ReDim TR(1 To L, 1 To C)
        If .Count > 1 Then .Item("2:" & .Count).Clear
    End With
    For R& = 2 To UBound(VA)
        Select Case VA(R, 1)
        Case DN1:  N& = N& + 1:    TR(N, 1) = DN1:       TR(N, 2) = VA(R, 2)
        Case "Total_Données":  TR(N, C - 1) = VA(R, 3):  TR(N, C) = -VA(R, 4)
        Case Else
                         V = Application.Match(VA(R, 1), NC, 0)
            If IsNumeric(V) Then TR(N, V) = VA(R, 2) - VA(R, 3)
        End Select
    Next
    With Feuil2.[A2].Resize(L, C)
        .NumberFormat = "[Blue]* #,##0.00 ;[Red]* #,##0.00 ;; @ "
               .Value = TR
    End With
End Sub

______________________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

______________________________________________________________________________________________________

Je suis Paris, Charlie, …

[RastaBomboclat]

Désolé Theze, je n'avais pas vu ton poste.
Je crois que c'est arrivé pendant que j'écrivais . Merci beaucoup. je vais le tester.

Merci aussi à toi Marc-L,
Je vais tester ton code.

A toute la communauté Développez.net Bonne Année!

[Theze]

Bonjour,

Un code qui donne ce que tu demande :

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
 
Sub Test()
 
    Dim Plage As Range
    Dim Cel As Range
    Dim TblDebit()
    Dim TblCredit()
    Dim TblDonneesCredit
    Dim TblDonneesDebit
    Dim I As Integer
    Dim J As Integer
    Dim Col As Integer
 
    'défini la plage
    With Worksheets("Format Initial")
 
        Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
 
    End With
 
    'titres des colonnes
    TblDonneesDebit = Array("", "", "Donnée_2", "Donnée_3", "Donnée_4", "Donnée_5", _
                            "Donnée_6", "Donnée_7", "Donnée_8")
 
    TblDonneesCredit = Array("Donnée_9", "Donnée_10", "Donnée_11", "Donnée_12", _
                             "Donnée_13", "Donnée_14", "Donnée_15")
 
    'défini le nombre de lignes du tableau (+ 1 = ligne des titres)
    I = Application.CountIf(Plage, "Total_Données") + 1
 
    'les bornes étant connues, dimensionne les tableaux
    ReDim TblDebit(1 To I, 1 To UBound(TblDonneesDebit) + 1)
    ReDim TblCredit(1 To I, 1 To UBound(TblDonneesCredit) + 1)
 
    'rempli la première ligne de chaque tableau (les titres)
    For I = 1 To UBound(TblDonneesDebit) + 1: TblDebit(1, I) = TblDonneesDebit(I - 1): Next I
    For I = 1 To UBound(TblDonneesCredit) + 1: TblCredit(1, I) = TblDonneesCredit(I - 1): Next I
 
    'évite la ligne des titres
    I = 2
 
    For Each Cel In Plage
 
        If Cel.Value <> "Total_Données" Then
 
            Select Case Cel.Value
 
                Case "Donnée_1"
                    TblDebit(I, 1) = Cel.Value
                    TblDebit(I, 2) = Cel.Offset(, 1).Value
 
                Case "Donnée_2", "Donnée_3", "Donnée_4", "Donnée_5", "Donnée_6", "Donnée_7", "Donnée_8"
                    J = Application.Match(Cel.Value, TblDonneesDebit, 0)
                    TblDebit(I, J) = Cel.Offset(, 1).Value
 
                Case "Donnée_9", "Donnée_10", "Donnée_11", "Donnée_12", "Donnée_13", "Donnée_14", "Donnée_15"
                    J = Application.Match(Cel.Value, TblDonneesCredit, 0)
                    TblCredit(I, J) = Cel.Offset(, 2).Value
 
            End Select
 
        Else
 
            'ligne suivante
            I = I + 1
 
        End If
 
    Next Cel
 
    With Worksheets("Format Final")
 
        'supprime tout formatage et valeurs
        With .Cells
 
            .Clear
            .ClearFormats
            .Font.ColorIndex = 0
            .Font.Bold = False
 
            .Borders(xlEdgeLeft).LineStyle = xlNone
            .Borders(xlEdgeTop).LineStyle = xlNone
            .Borders(xlEdgeBottom).LineStyle = xlNone
            .Borders(xlEdgeRight).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
 
            .FormatConditions.Delete
 
        End With
 
        'colle les valeurs, formate les nombres et colore la fonte en bleu
        .Range(.Cells(1, 1), .Cells(UBound(TblDebit, 1), UBound(TblDebit, 2))).Value = TblDebit
        .Range(.Cells(1, 1), .Cells(UBound(TblDebit, 1), UBound(TblDebit, 2))).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
        .Range(.Cells(1, 3), .Cells(UBound(TblDebit, 1), UBound(TblDebit, 2))).Font.ColorIndex = 5
 
        Col = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
 
        'double traits verticaux en séparation des tableaux
        .Range(.Cells(1, Col - 1), .Cells(UBound(TblDebit, 1), Col - 1)).Borders(xlEdgeRight).LineStyle = xlDouble
 
        'colle les valeurs, formate les nombres et colore la fonte en bleu
        .Range(.Cells(1, Col), .Cells(UBound(TblCredit, 1), UBound(TblCredit, 2) + Col - 1)).Value = TblCredit
        .Range(.Cells(1, Col), .Cells(UBound(TblCredit, 1), UBound(TblCredit, 2) + Col - 1)).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
        .Range(.Cells(1, Col), .Cells(UBound(TblCredit, 1), UBound(TblCredit, 2) + Col - 1)).Font.ColorIndex = 3
 
        'double traits verticaux en séparation des tableaux et colonnes de sommage
        Col = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
        .Range(.Cells(1, Col - 1), .Cells(UBound(TblDebit, 1), Col - 1)).Borders(xlEdgeRight).LineStyle = xlDouble
 
        'titres de deux colonnes
        .Cells(1, Col).Value = "Total_Debit"
        .Cells(1, Col + 1).Value = "Total_Crédit"
 
        'formule de sommage
        .Cells(2, Col).Formula = "=SUM(C2:I2)": .Cells(2, Col).AutoFill .Range(.Cells(2, Col), .Cells(UBound(TblDebit, 2) - 1, Col))
        .Cells(2, Col + 1).Formula = "=SUM(J2:P2)": .Cells(2, Col + 1).AutoFill .Range(.Cells(2, Col + 1), .Cells(UBound(TblCredit, 2) + 1, Col + 1))
 
        'coloration des fontes
        .Range(.Cells(2, Col), .Cells(UBound(TblDebit, 2) - 1, Col)).Font.ColorIndex = 5
        .Range(.Cells(2, Col + 1), .Cells(UBound(TblCredit, 2) + 1, Col + 1)).Font.ColorIndex = 3
 
        'mise en gras de la ligne d'entêtes
        .Range(.Cells(1, 3), .Cells(1, Col + 1)).Font.Bold = True
 
        'cadrillage
        With .Range(.Cells(1, 1), .Cells(UBound(TblDebit, 1), Col + 1))
 
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlInsideHorizontal).LineStyle = xlContinuous
 
        End With
 
        'double traits verticaux en fin de tableau
        .Range(.Cells(1, Col + 1), .Cells(UBound(TblDebit, 1), Col + 1)).Borders(xlEdgeRight).LineStyle = xlDouble
 
        With .Range(.Cells(2, 1), .Cells(UBound(TblCredit, 1), Col + 1))
 
            .FormatConditions.Add 2, , "=MOD(LIGNE();2)=0"
            .FormatConditions(1).Interior.Color = 10086399
 
        End With
 
    End With
 
End Sub

Dans le cas où "Donnée_1" serait le en fait code (style LUA1234 comme indiqué dans un classeur précédemment posté), remplace le bloc Select Case par celui-ci :

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
 
            Select Case Cel.Value
 
                Case "Donnée_2", "Donnée_3", "Donnée_4", "Donnée_5", "Donnée_6", "Donnée_7", "Donnée_8"
                    J = Application.Match(Cel.Value, TblDonneesDebit, 0)
                    TblDebit(I, J) = Cel.Offset(, 1).Value
 
                Case "Donnée_9", "Donnée_10", "Donnée_11", "Donnée_12", "Donnée_13", "Donnée_14", "Donnée_15"
                    J = Application.Match(Cel.Value, TblDonneesCredit, 0)
                    TblCredit(I, J) = Cel.Offset(, 2).Value
 
                Case Else
                    TblDebit(I, 1) = Cel.Value
                    TblDebit(I, 2) = Cel.Offset(, 1).Value
 
            End Select

[RastaBomboclat]

Theze,

Ton code fonctionne à merveille. Il n'y a plus rien à y ajouter. Complet!

Merci Theze. et merci a toute la communauté developpez.net.

[Marc-L]

Mon code du post #15 fonctionne bien avec le classeur joint dans le post #14, a-t-il été testé au moins ? …

[RastaBomboclat]

Oui Marc-L,

Merci pour ton code. je crois que j'y avais répondu mais je ne sais pas comment et pourquoi, le post n'apparait pas ici mais dans un autre "module" en solo, où je vous ai remercier toi et Theze, pour vos code.

Je ne l'ai plus utilisé pour le cas de mon travaille parce que je me suis senti un peu géner de dire que les "Donnée_1" n'était pas une constante mais plutôt une variable. C'est en fait le Code_Employé. Il y en a autant qu'il y a d'employés. Je l'avais dis dans un post plus haut. Je ne voulais pas trop demander
Mais merci beaucoup pour votre soutient et assistance.