Remplir un tableau à partir d'un autre

Version imprimable

Voir 40 message(s) de cette discussion en une page

23/03/2012, 11h12
sylvestre09

1 pièce(s) jointe(s)

Remplir un tableau à partir d'un autre

Bonjour le forum,

Voilà j'ai beau chercher à trouver une solution pour mon cas mais je n'ai rien trouvé donc je me retourne vers vous pour me donner un coup de main.

J'ai un tableau dans une feuille qui contient plusieurs cellules j'aimerais transférer quelques données de ce tableau vers un autre qui est sur la même feuille selon la valeur et la date !

Comme c'est dur à expliquer je joint un exemple !
Dans la feuilles 2 il y'a le resultat souhaité on voit très bien que la date est la valeur sont les conditions pour remplir ce tableau, la colonne C contient des ref uniques pour chaque ligne!

Toutes suggestions seront les bienvenues !

Merci d'avance
23/03/2012, 17h21
Daniel.C

Bonjour,

Ce n'est pas très clair pour moi. Si Feuil2 contient le résultat escompté, où se trouvent les données initiales ? Donne un exemple.
26/03/2012, 10h58
sylvestre09

Bonjour
Les données initiales se trouvent dans la "feuil1" le resultat doit apparaitre dans la "feuil1" aussi ! pour les exemples c'est dans la "feuil2" que ca se trouve !!!
Merci
26/03/2012, 11h12
Daniel.C

Bonjour,

Citation:

Les données initiales se trouvent dans la "feuil1"

Il n'y a pas de données dans Feuil1, il n'y a que des entêtes (et une date).
26/03/2012, 12h27
sylvestre09

1 pièce(s) jointe(s)

c'est la colonne V c'est là ou je veux remplir les données !! les données initiales sont dans la colonne C:L

voilà un debut de solution qu'on m'a proposé jusque là tout fonctionne sauf que j'arrive pas a trier et faire la séparation des opérations de chaque mois c'est a dire celle du mois de mars en face et les séparer du mois suivant ...

Bonjour,

Mets la macro suivante dans un module standard :

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Option Base 1
Sub test()
    Dim c As Range, Tabl(12) As String, Ctr As Double
    Dim Ligne As Long, LigneDeb As Long, LigneCred As Long
    Ligne = 2
    For Each c In Range([E4], Cells(Rows.Count, 5).End(xlUp))
        Tabl(Month(c.Value)) = "X"
    Next c
    For i = 1 To 12
        Ctr = 0
        If Tabl(i) <> "" Then
            Ligne = Ligne + 2
            Cells(Ligne, 26) = DateSerial(2012, i, 1)
            Cells(Ligne, 26).NumberFormat = "mmm-yyyy"
            LigneDeb = Ligne
            LigneCred = Ligne
            For Each c In Range([E4], Cells(Rows.Count, 5).End(xlUp))
                If DateSerial(Year(c.Value), Month(c.Value), 1) = Cells(Ligne, 26) Then
                    If c.Offset(, 2) > 0 Then
                        Cells(LigneCred, "AA") = Cells(c.Row, 3)
                        Cells(LigneCred, "AB") = Cells(c.Row, 5)
                        Cells(LigneCred, "AC") = Cells(c.Row, 8)
                        Cells(LigneCred, "AD") = Cells(c.Row, 7)
                        Ctr = Ctr + Cells(c.Row, 7)
                        LigneCred = LigneCred + 1
                    Else
                        Cells(LigneDeb, "V") = Cells(c.Row, 3)
                        Cells(LigneDeb, "W") = Cells(c.Row, 5)
                        Cells(LigneDeb, "X") = Cells(c.Row, 8)
                        Cells(LigneDeb, "Y") = Cells(c.Row, 7)
                        Ctr = Ctr + Cells(c.Row, 7)
                        LigneDeb = LigneDeb + 1
                    End If
                End If
            Next c
            Cells(Ligne + 1, 26) = Ctr
            Cells(Ligne + 1, 26).NumberFormat = "General"
            Ligne = Application.Max(LigneCred, LigneDeb)
        End If
    Next i
End Sub

PS. Au cas où les dates d'échéance sont sur plusieurs années, il faudra modifier la macro.

27/03/2012, 10h20
sylvestre09

Bonjour Daniel c'est tout à fait ce que je voulais !!! mais effectivement les dates d'échéances peuvent s'etaler sur plusieurs années :?
qu'est ce qu'il faut changer ?
Grand Merci !!

Bonjour,

Essaie :

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Sub test()
    Dim c As Range, Ctr As Double, x As Range
    Dim Ligne As Long, LigneDeb As Long, LigneCred As Long
    Dim Min As Date, Dico As Object
    Ligne = 2
    Set Dico = CreateObject("Scripting.Dictionary")
    For Each c In Range([E4], Cells(Rows.Count, 5).End(xlUp))
        If Not Dico.exists(DateSerial(Year(c.Value), Month(c.Value), 1)) Then
            Dico.Add DateSerial(Year(c.Value), Month(c.Value), 1), _
                DateSerial(Year(c.Value), Month(c.Value), 1)
        End If
    Next c
    [AH:AH].ClearContents
    i = 0
    For Each Item In Dico.items
        i = i + 1
        Cells(i, "AH") = Item
    Next Item
    [AH:AH].Sort Range("AH1"), xlAscending, Header:=xlNo
    For Each x In Range([AH1], Cells(Rows.Count, "AH").End(xlUp))
        Ctr = 0
        Ligne = Ligne + 2
        Cells(Ligne, 26) = DateSerial(Year(x.Value), Month(x.Value), 1)
        Cells(Ligne, 26).NumberFormat = "mmm-yyyy"
        LigneDeb = Ligne
        LigneCred = Ligne
        For Each c In Range([E4], Cells(Rows.Count, 5).End(xlUp))
            If DateSerial(Year(c.Value), Month(c.Value), 1) = Cells(Ligne, 26) Then
                If c.Offset(, 2) > 0 Then
                    Cells(LigneCred, "AA") = Cells(c.Row, 3)
                    Cells(LigneCred, "AB") = Cells(c.Row, 5)
                    Cells(LigneCred, "AC") = Cells(c.Row, 8)
                    Cells(LigneCred, "AD") = Cells(c.Row, 7)
                    Ctr = Ctr + Cells(c.Row, 7)
                    LigneCred = LigneCred + 1
                Else
                    Cells(LigneDeb, "V") = Cells(c.Row, 3)
                    Cells(LigneDeb, "W") = Cells(c.Row, 5)
                    Cells(LigneDeb, "X") = Cells(c.Row, 8)
                    Cells(LigneDeb, "Y") = Cells(c.Row, 7)
                    Ctr = Ctr + Cells(c.Row, 7)
                    LigneDeb = LigneDeb + 1
                End If
            End If
        Next c
        Cells(Ligne + 1, 26) = Ctr
        Cells(Ligne + 1, 26).NumberFormat = "General"
        Ligne = Application.Max(LigneCred, LigneDeb)
    Next x
    [AH:AH].ClearContents
End Sub

Daniel merci infiniment ca fonctionne très bien ! j'ai une dérnière question si t'as le temps de me rependre bien sur ! en fait j'aimerai faire tourner cette macro pour des onglets d'habitude je mets

Code:

1
2
3
with sheets(occurs)
code
end with

pour faire la meme chose avec ce code j'ai ajouter des points devant chaque "Cells" mais ca ne fonctionne pas ! as tu une idée ?

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
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
Sub test(occurs As String)
    Dim c As Range, Ctr As Double, x As Range
    Dim Ligne As Long, LigneDeb As Long, LigneCred As Long
    Dim Min As Date, Dico As Object
 
    With Sheets(occurs)
    Ligne = 2
    Set Dico = CreateObject("Scripting.Dictionary")
         For Each c In Range(.[E4], .Cells(Rows.Count, 5).End(xlUp))
           If Not Dico.exists(DateSerial(Year(c.Value), Month(c.Value), 1)) Then
             Dico.Add DateSerial(Year(c.Value), Month(c.Value), 1), _
                 DateSerial(Year(c.Value), Month(c.Value), 1)
         End If
    Next c
    [AH:AH].ClearContents
    i = 0
    For Each Item In Dico.items
        i = i + 1
        .Cells(i, "AH") = Item
    Next Item
    [AH:AH].Sort Range("AH1"), xlAscending, Header:=xlNo
    For Each x In Range(.[AH1], .Cells(Rows.Count, "AH").End(xlUp))
        Ctr = 0
        Ligne = Ligne + 2
        .Cells(Ligne, 26) = DateSerial(Year(x.Value), Month(x.Value), 1)
        .Cells(Ligne, 26).NumberFormat = "mmm-yyyy"
        LigneDeb = Ligne
        LigneCred = Ligne
        For Each c In Range(.[E4], .Cells(Rows.Count, 5).End(xlUp))
            If DateSerial(Year(c.Value), Month(c.Value), 1) = .Cells(Ligne, 26) Then
                If c.Offset(, 2) > 0 Then
                    .Cells(LigneCred, "AA") = .Cells(c.Row, 3)
                    .Cells(LigneCred, "AB") = .Cells(c.Row, 5)
                    .Cells(LigneCred, "AC") = .Cells(c.Row, 8)
                    .Cells(LigneCred, "AD") = .Cells(c.Row, 7)
                    Ctr = Ctr + .Cells(c.Row, 7)
                    LigneCred = LigneCred + 1
                Else
                    .Cells(LigneDeb, "V") = .Cells(c.Row, 3)
                    .Cells(LigneDeb, "W") = .Cells(c.Row, 5)
                    .Cells(LigneDeb, "X") = .Cells(c.Row, 8)
                    .Cells(LigneDeb, "Y") = .Cells(c.Row, 7)
                    Ctr = Ctr + .Cells(c.Row, 7)
                    LigneDeb = LigneDeb + 1
                End If
            End If
        Next c
        .Cells(Ligne + 1, 26) = Ctr
        .Cells(Ligne + 1, 26).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
        Ligne = Application.Max(LigneCred, LigneDeb)
    Next x
    [AH:AH].ClearContents
 
    End With
End Sub

au cas ou quelqu'un est intéressé :lol:
Merci encore Daniel

Daniel excuse moi de te déranger encore une fois mais je viens de me rendre compte que le tri ne fonctionne pas j'ai seulement changer les colonnes du nouveau tableau

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
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
Sub test(occurs As String)
    Dim c As Range, Ctr As Double, x As Range
    Dim Ligne As Long, LigneDeb As Long, LigneCred As Long
    Dim Min As Date, Dico As Object
    
    With Sheets(occurs)
    Ligne = 2
    Set Dico = CreateObject("Scripting.Dictionary")
         For Each c In Range(.[E4], .Cells(Rows.Count, 5).End(xlUp))
           If Not Dico.exists(DateSerial(Year(c.Value), Month(c.Value), 1)) Then
             Dico.Add DateSerial(Year(c.Value), Month(c.Value), 1), _
                 DateSerial(Year(c.Value), Month(c.Value), 1)
         End If
    Next c
    [AH:AH].ClearContents
    i = 0
    For Each Item In Dico.items
        i = i + 1
        .Cells(i, "AH") = Item
    Next Item
    [AH:AH].Sort Range("AH1"), xlAscending, Header:=xlNo
    For Each x In Range(.[AH1], .Cells(Rows.Count, "AH").End(xlUp))
        Ctr = 0
        Ligne = Ligne + 2
        .Cells(Ligne, 40) = DateSerial(Year(x.Value), Month(x.Value), 1)
        .Cells(Ligne, 40).NumberFormat = "mmm-yyyy"
        LigneDeb = Ligne
        LigneCred = Ligne
        For Each c In Range(.[E4], .Cells(Rows.Count, 5).End(xlUp))
            If DateSerial(Year(c.Value), Month(c.Value), 1) = .Cells(Ligne, 40) Then
                If c.Offset(, 2) > 0 Then
                    .Cells(LigneCred, "AO") = .Cells(c.Row, 3)
                    .Cells(LigneCred, "AP") = .Cells(c.Row, 5)
                    .Cells(LigneCred, "AQ") = .Cells(c.Row, 8)
                    .Cells(LigneCred, "AR") = .Cells(c.Row, 7)
                    Ctr = Ctr + .Cells(c.Row, 7)
                    LigneCred = LigneCred + 1
                Else
                    .Cells(LigneDeb, "AJ") = .Cells(c.Row, 3)
                    .Cells(LigneDeb, "AK") = .Cells(c.Row, 5)
                    .Cells(LigneDeb, "AL") = .Cells(c.Row, 8)
                    .Cells(LigneDeb, "AM") = .Cells(c.Row, 7)
                    Ctr = Ctr + .Cells(c.Row, 7)
                    LigneDeb = LigneDeb + 1
                End If
            End If
        Next c
        .Cells(Ligne + 1, 40) = Ctr
        .Cells(Ligne + 1, 40).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
        Ligne = Application.Max(LigneCred, LigneDeb)
    Next x
    [AH:AH].ClearContents
    
    End With
End Sub

une idée ?

28/03/2012, 13h01
Daniel.C

Bonjour,

Qu'est-ce qui doit être trié ? Dans la solution que je t'ai proposée, il y avait un tri sur le mois des dates d'échéance.
28/03/2012, 13h16
sylvestre09

exactement sauf que là il ne fait plus le tri j'ai essayé de comprendre et je m'apercoit que dans la colonne AH là ou il fait le tri (je suppose) les valeurs ne le sont pas ni dans la colonne mois (AN)

en fait je viens de tester ton code sans ajouter la fonction with et les points et ca marche parfaitement !!! tu ne vois rien d'anormal ?? j'ai essayé de rajouter un point devant " xlAscending " mais ca ne fonctionne pas :(
28/03/2012, 15h04
Daniel.C

Citation:

j'ai seulement changer les colonnes du nouveau tableau

Ça vient sans doute de là. Est-ce que tu peux mettre le nouveau classeur en pièce jointe ?
28/03/2012, 15h28
sylvestre09

1 pièce(s) jointe(s)

voilà un exemple
maintenant il bloque pas mais regardes le tri il commence par l'année 2013 ensuite 2012 ...
Merci encore Daniel !!

1. Est-ce qu'il y a les bonnes données dans les colonnes Montant et Taux (colonnes F et G) ?
2. Le tri est rectifié dans le code suivant. Il s'agissait d'un oubli de points devant les "[AH:AH]". D'une façon générale, mets des points devant les mots clés "Range", "Rows" etc. Ca n'a pas d'impportance dans un module standard mais ça en a dans un module feuille ou thisworkbook.

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
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
Sub test(occurs As String)
    Dim c As Range, Ctr As Double, x As Range
    Dim Ligne As Long, LigneDeb As Long, LigneCred As Long
    Dim Min As Date, Dico As Object
 
    With Sheets(occurs)
    Ligne = 2
    Set Dico = CreateObject("Scripting.Dictionary")
         For Each c In .Range(.[E4], .Cells(.Rows.Count, 5).End(xlUp))
           If Not Dico.exists(DateSerial(Year(c.Value), Month(c.Value), 1)) Then
             Dico.Add DateSerial(Year(c.Value), Month(c.Value), 1), _
                 DateSerial(Year(c.Value), Month(c.Value), 1)
         End If
    Next c
    .[AH:AH].ClearContents
    i = 0
    For Each Item In Dico.items
        i = i + 1
        .Cells(i, "AH") = Item
    Next Item
    .[AH:AH].Sort Range("AH1"), xlAscending, Header:=xlNo
    For Each x In .Range(.[AH1], .Cells(.Rows.Count, "AH").End(xlUp))
        Ctr = 0
        Ligne = Ligne + 2
        .Cells(Ligne, 40) = DateSerial(Year(x.Value), Month(x.Value), 1)
        .Cells(Ligne, 40).NumberFormat = "mmm-yyyy"
        LigneDeb = Ligne
        LigneCred = Ligne
        For Each c In .Range(.[E4], .Cells(.Rows.Count, 5).End(xlUp))
            If DateSerial(Year(c.Value), Month(c.Value), 1) = .Cells(Ligne, 40) Then
                If c.Offset(, 2) > 0 Then
                    .Cells(LigneCred, "AO") = .Cells(c.Row, 3)
                    .Cells(LigneCred, "AP") = .Cells(c.Row, 5)
                    .Cells(LigneCred, "AQ") = .Cells(c.Row, 8)
                    .Cells(LigneCred, "AR") = .Cells(c.Row, 7)
                    Ctr = Ctr + .Cells(c.Row, 7)
                    LigneCred = LigneCred + 1
                Else
                    .Cells(LigneDeb, "AJ") = .Cells(c.Row, 3)
                    .Cells(LigneDeb, "AK") = .Cells(c.Row, 5)
                    .Cells(LigneDeb, "AL") = .Cells(c.Row, 8)
                    .Cells(LigneDeb, "AM") = .Cells(c.Row, 7)
                    Ctr = Ctr + .Cells(c.Row, 7)
                    LigneDeb = LigneDeb + 1
                End If
            End If
        Next c
        .Cells(Ligne + 1, 40) = Ctr
        .Cells(Ligne + 1, 40).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
        Ligne = Application.Max(LigneCred, LigneDeb)
    Next x
    .[AH:AH].ClearContents
 
    End With
End Sub

28/03/2012, 17h01
sylvestre09

slt daniel oui les données sont les bonnes (pas l'entéte du tableau) j'ai essayé avec les points comme dans le code que tu m'as ecris mais ca ne fonctionne pas erreur 1004 reference de tri non valide !!!
28/03/2012, 17h44
Daniel.C

Oups, j'avais oublié un ".". Remplace :

Code:

.[AH:AH].Sort Range("AH1"), xlAscending, Header:=xlNo

par :

Code:

.[AH:AH].Sort .Range("AH1"), xlAscending, Header:=xlNo
29/03/2012, 10h01
sylvestre09

Bonjour Daniel bon je ne sais pas si tu as tésté le truc ou pas car il fait le tri mnt sauf qu'il me mets une meme opération dans plusieurs endroits c'est à dire une opération d'une date d'echéance le 31-01-2013 il la met dans janvier mais il la réecri dans le mois de septembre 2012 par exemple c'est la partie du dictionnaire qui gére ça ?? pour ne pas avoir des doublons dans le tableau pret emprunt !!?
PS: je viens de remarquer que les dates changent de la page recap à la page devise :cry:
07-06-13 devient 06-07-13 et bcp d'autre dates :s
29/03/2012, 11h01
Daniel.C
Bonjour,

Citation:

PS: je viens de remarquer que les dates changent de la page recap à la page devise

Je ne sais pas si on parle de la même chose. Je ne touche pas à la feuille Recap. Je teste la macro "Test" à l'aide de la macro :
Code:

1 2 3 Sub LanceTest() test "EUR" End Sub
Peux-tu me dire sur quelles feuilles tu constates des anomalies ?
29/03/2012, 11h08
sylvestre09

dans la page recap on a les opérations quand on clique sur le bouton dans la "feuil1) les opérations dans la page recap vont alimenter les onglets occurs (devises) moi aussi je teste sur la page eur
si on rajoute une opération dans l'onglet recap et qu'on clique sur le bouton tu verras que les dates peuvent changer
par exemple si tu rajoute

Citation:

120327920 29/03/2012 06/07/2014 EUR 500 000,00 1,000 Dep C Ste x xx yu
120327922 29/03/2012 04/10/2013 EUR 4 000 000,00 2,000 Dep C Ste x xx yu

et que tu cliques sur le bouton les dates deviendrons

Citation:

120327920 29/03/2012 07/06/2014 EUR 500 000,00 1 Dep C Ste x xx yu
120327922 29/03/2012 10/04/2013 EUR 4 000 000,00 2 Dep C Ste x xx yu
29/03/2012, 11h16
Daniel.C

On série les problèmes.
1.

Citation:

car il fait le tri mnt sauf qu'il me mets une meme opération dans plusieurs endroits c'est à dire une opération d'une date d'echéance le 31-01-2013 il la met dans janvier mais il la réecri dans le mois de septembre 2012 par exemple c'est la partie du dictionnaire qui gére ça ?? pour ne pas avoir des doublons dans le tableau pret emprunt !!?

Je ne comprends pas ce que tu veux dire. Est-ce que tu peux me donner un exemple ?
2.

Citation:

si on rajoute une opération dans l'onglet recap et qu'on clique sur le bouton tu verras que les dates peuvent changer

Ça se passe dans quelle macro ?

Voir 40 message(s) de cette discussion en une page