Code pour Couper/Coller décale mon Offset

Version imprimable

2 pièce(s) jointe(s)

Bonjour à tous,
J'ai une série de données que je souhaite traiter: la première ligne contient des dates la seconde des pourcentages associés à ces dates, la troisième ligne contient des dates, la quatrième des pourcentages associés à ces dates etc...
Les dates de chaque série ne sont pas identiques

Pièce jointe 174190

Je souhaiterai obtenir ceci

Pièce jointe 174192

J'ai donc créé du code, qui est encore en cours de création, pour décaler mes lignes dans un sens ou dans l'autre pour avoir des dates identiques sur chaque colonne:

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
Sub test()
Dim Baseline As Worksheet
Dim Actual As Worksheet
Dim Bsl As Range
Dim Act As Range
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim n As Integer
Dim p As Integer
Set Baseline = ThisWorkbook.Sheets("Baseline")
Set Actual = ThisWorkbook.Sheets("Actual")
Set Bsl = Baseline.Range("A1")
Set Act = Actual.Range("A1")
Bsl = Bsl.Offset(0)
Act = Act.Offset(0)
i = 0
j = 0
k = 0
 
                Do While Bsl.Offset(0) <> Bsl.Offset(i + 5, j)
                    If Bsl.Offset(i + 5, j) <> "" And Bsl.Offset(0) < Bsl.Offset(i + 5, j) Then
                            Range(Bsl.Offset(i + 5, j), Bsl.Offset(i + 9, j).End(xlToRight)).Cut
                            Bsl.Offset(i + 5, j + 1).Select
                            ActiveSheet.Paste
                            Bsl.Offset(i + 5, j) = Bsl.Offset(i, j)
                            Bsl.Offset(i + 5, j).NumberFormat = "[$-410]dd-mmm-yy;@"
                            Bsl.Offset(i + 6, j) = 0
                            Bsl.Offset(i + 6, j).NumberFormat = "0.00%"
 
                    End If
 
                    If Bsl.Offset(i + 5, j) <> "" And Bsl.Offset(i, j) > Bsl.Offset(i + 5, j) Then
 
                            Application.CutCopyMode = False
                            Range(Bsl.Offset(i, j), Bsl.Offset(i, j + 5).End(xlToRight).End(xlDown)).Cut
                            Bsl.Offset(i, j + 1).Select
                            ActiveSheet.Paste
                            Bsl.Offset(i, j) = Bsl.Offset(i + 5, j)
                            Bsl.Offset(i, j).NumberFormat = "[$-410]dd-mmm-yy;@"
                            Bsl.Offset(i + 1, j) = 0
                            Bsl.Offset(i + 1, j).NumberFormat = "0.00%"
 
                    End If
                    i = i + 5
 
                Loop
 
End Sub

Mon problème survient après les lignes suivantes:

Code:

1
2
3
4
 Range(Bsl.Offset(i, j), Bsl.Offset(i, j + 5).End(xlToRight).End(xlDown)).Cut
 Bsl.Offset(i, j + 1).Select
 ActiveSheet.Paste
 Bsl.Offset(i, j) = Bsl.Offset(i + 5, j)

Alors que Bsl.Offset(i, j) devrai etre situé en colonne A, après l'opération coller, elle se situe en colonne B.
Je pense que cela vient du code

Code:

1
2
Bsl.Offset(i, j + 1).Select
 ActiveSheet.Paste

Mais je n'ai pas trouvé de méthode plus orthodoxe pour parvenir à décaler mes valeurs ( en plus j'utilise du .Select dont je souhaiterai me passer).

Quelqu'un a-t-il une idée soit pour couper/coller "proprement" soit pour éviter le décalage de mon offset?

Merci pour votre aide et votre collaboration

Eric

08/04/2015, 18h04
joe.levrai

Bonjour eric4459

si j'ai bien compris, tu souhaites combler les mois manquants dans chaque ligne, afin d'obtenir pour chaque ligne la même série de dates, et si la date n'existait pas, tu lui affectes un pourcentage à 0 ?

si tel est le cas, tu peux très bien :

-parcourir toutes tes lignes dates pour trouver tous les mois existants, qui constituerons donc la série date définitive.
- reporter cette série définitive dans une nouvelle feuille en conservant la même numérotation des lignes
- balayer les lignes "pourcentages" pour trouver les pourcentage qui existaient ... ou le mettre à 0 si inexistant ?
08/04/2015, 22h42
eric4459
Bonjour Joe.levrai
Effectivement c'est ce que cherche à réaliser: si les dates ne correspondent pas, je décale la série et mets la date la plus ancienne des deux et 0 comme % dans la cellule devenue vide.
Je crois que c'est la méthode couper/coller qui est en cause.
Normalement, mais c'est là que je bloque, je devrai affecter les nouvelles valeurs (date et % à 0)en colonne A mais c'est en colonne B que le code intervient.
Code:

1 2 3 Set Bsl = Baseline.Range("A1") Bsl = Bsl.Offset(0) Bsl.Offset(i, j) = Bsl.Offset(i + 5, j)
Je ne comprend pas trop pourquoi, d'après moi cela vient de
Code:

1 2 3 Range(Bsl.Offset(i, j), Bsl.Offset(i, j + 5).End(xlToRight).End(xlDown)).Cut Bsl.Offset(i, j + 1).Select ActiveSheet.Paste
et je bloque.

Pourrais tu m'en dire un peu plius sur la solution que tu préconises?
Eric

un essai rapide, je suis parti de ton print écran (= les dates sont toujours dans l'ordre croissant)
j'ai testé sur 3 lignes et 17 colonnes et ça fonctionne
regarde si c'est ok, et surtout si c'est pas trop long, y'a encore pas mal d'optimisations possibles

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
56
57
58
59
60
61
62
63
64
 
Sub Conversion()
 
    Dim ShSource As Worksheet
    Dim ShDest As Worksheet
    Dim Plage As Range
    Dim ListeDate() As String
    Dim NbColDest As Long
    Dim i As Long
    Dim j As Long
    Dim t As Long
 
    Set ShSource = ThisWorkbook.Worksheets("Feuil1")
    Set ShDest = ThisWorkbook.Worksheets("Feuil2")
 
    With ShSource
 
        ' l'ensemble des lignes de dates
        Set Plage = .Range(.Cells(1, 1), .Cells(1, .UsedRange.Columns.Count))
        For i = 3 To .UsedRange.Rows.Count Step 2
            Set Plage = Union(Plage, .Range(.Cells(i, 1), .Cells(i, .UsedRange.Columns.Count)))
        Next i
 
        ' liste sans doublon des dates, triées par ordre croissant
        ListeDate = TriDate(Split(SansDoublon(Plage, "$"), "$"))
 
        ' boucle sur chaque ligne de date
        For i = 1 To .UsedRange.Rows.Count Step 2
 
            ' écriture des dates dans la feuille de destination
            ShDest.Cells(i, 1) = Format(ListeDate(UBound(ListeDate)), "[$-40C]dd-mmm-yy;@")
            For j = LBound(ListeDate) To UBound(ListeDate) - 1
                ShDest.Cells(i, j + 2) = Format(ListeDate(j), "[$-40C]dd-mmm-yy;@")
            Next j
 
            NbColDest = ShDest.UsedRange.Columns.Count
            t = 1
 
            For j = 1 To NbColDest
                Do Until t > NbColDest
                    ' écriture de 0,00% pour les dates inexistantes
                    If CDate(.Cells(i, j)) <> CDate(ShDest.Cells(i, t)) Then
                        ShDest.Cells(i + 1, t) = 0
                        t = t + 1
 
                    ' écriture du pourcentage pour les dates existantes
                    Else
                        ShDest.Cells(i + 1, t) = .Cells(i + 1, j)
                        t = t + 1
                        Exit Do
                    End If
                Loop
            Next j
 
            ShDest.Range(ShDest.Cells(i + 1, 1), ShDest.Cells(i + 1, NbColDest)).NumberFormat = "0%00"
 
        Next i
    End With
 
    Set Plage = Nothing
    Set ShDest = Nothing
    Set ShSource = Nothing
 
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Function TriDate(ListeDate As Variant) As Variant
Dim k As Long
Dim m As Long
Dim Chaine As Date
 
For m = 0 To UBound(ListeDate)
    For k = UBound(ListeDate) To 0 Step -1
        If CDate(ListeDate(k)) < CDate(ListeDate(m)) Then
            Chaine = ListeDate(k)
            ListeDate(k) = ListeDate(m)
            ListeDate(m) = Chaine
        End If
    Next k
Next m
 
TriDate = ListeDate
 
End Function

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
 
Function SansDoublon(Plage As Range, Optional Separateur As String) As String
 
    Dim EnumListe As String
    Dim Cell As Range
 
    EnumListe = ""
 
    If Separateur = "" Then
        Separateur = ","
    End If
 
    For Each Cell In Plage.Cells
        If EnumListe = "" And Cell <> "" Then
            EnumListe = EnumListe & Separateur & Cell & Separateur
        ElseIf Not EnumListe Like "*" & Separateur & Cell & Separateur & "*" And Cell <> "" Then
            EnumListe = EnumListe & Cell & Separateur
        End If
    Next Cell
 
    If EnumListe <> "" Then
        EnumListe = Mid(EnumListe, 2, Len(EnumListe) - 2)
    End If
 
    SansDoublon = EnumListe
 
End Function

09/04/2015, 11h05
eric4459
Bonjour joe.levrai,
Ton code fonctionne comme je le souhaite et de plus il est hyper rapide, cependant mon niveau de connaissance en VBA ne me permet pas d'en comprendre toute les subtilités, j'en suis encore au b-a ba, avancé certes mais au b-a ba tout de même.
Il faudra que j'étudie un peu plus ton code et les principes utilisés, les tableaux il me semble.
Mon problème à l'origine est différent, tu m'apporte du code sur un plateau, je t'en remercie, mais je ne comprend toujours pas pourquoi les lignes suivantes provoquent un décalage de mon offset.
Code:

1 2 3 Range(Bsl.Offset(i, j), Bsl.Offset(i, j + 5).End(xlToRight).End(xlDown)).Cut Bsl.Offset(i, j + 1).Select ActiveSheet.Paste
J'ai en effet testé mon code sans ces lignes, donc sans tri des dates, et tout fonctionne comme je le souhaite, la fonction Offset répond au doigt et à l'oeil.
Eric
09/04/2015, 11h35
joe.levrai
Bonjour,

y'a des choses que je ne comprend pas très bien dans ton code
je met de côté les variables liées à la feuille Actual qui ne servent à rien, ça doit être pour la suite de ton code qui n'était pas terminé
Code:

1 2 3 4 Bsl = Bsl.Offset(0) Do While Bsl.Offset(0) <> Bsl.Offset(i + 5, 0)
que voulais-tu faire avec ces Bsl.Offset(0) ?
sauf erreur, tu peux utiliser immédiatement Bsl

ensuite, ton j = 0 ne sert pas à grand chose, puisque tu n'incrémente jamais ton j, c'est plus lisible de laisser 0 dans tes offset à la place de j

après, je ne comprend pas non plus pourquoi tu boucle sur des pas de 5 lignes au lieu de boucler sur des pas de 2 lignes
Code:

1 2 3 4 5 6 7 8 Do While Bsl <> Bsl.Offset(i + 5, 0) ' blabla i = i + 5 Loop
09/04/2015, 11h59
eric4459

Rebonjour joe.levrai
C'est vrai mon code est en cours de création et la feuille Actual me servira plus tard.
J'utilise les Offset afin de pouvoir "naviguer" dans ma feuille, c'est une habitude, peut-être mauvaise, que j'ai prise et qui jusqu'à aujourd'hui ne me posait pas de problèmes.
Quant à mon j, je souhaite l'utiliser pour effecteur un décalage supplémentaire si par exemple dans ma première série le mois est octobre et que dans la deuxième série le mois est janvier, il me faudra décaler de 3 colonnes.
Le bouclage sur 5 lignes vient du fait que j'ai sous mes dates 4 lignes de données, que j'avais supprimé dans l'exemple.
Eric

je suis désolé, mais je n'ai pas d'explication pour ton décalage après avoir analysé ton code pendant 15min, et j'avoue ne pas être motivé à reproduire les scenarii :oops:

En revanche ! Je te fais des sous-titre pour ma proposition, histoire que tu puisses décortiquer et assimiler :

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
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
 
 
Sub Conversion()
 
    Dim ShSource As Worksheet
    Dim ShDest As Worksheet
    Dim Plage As Range
    Dim ListeDate() As String
    Dim NbColDest As Long
    Dim i As Long
    Dim j As Long
    Dim t As Long
 
    Set ShSource = ThisWorkbook.Worksheets("Feuil1")
    Set ShDest = ThisWorkbook.Worksheets("Feuil2")
 
    With ShSource
 
        ' l'ensemble des lignes de dates
        ' on prend la première ligne pour initialiser Plage
        ' (on limite la plage en partant de la colonne A, et en s'arrêtant à la dernière colonne remplie de la feuille)
        Set Plage = .Range(.Cells(1, 1), .Cells(1, .UsedRange.Columns.Count))
 
        ' pour chaque ligne écrite de la feuille
        ' (en commençant par la ligne 3 et en sautant une ligne sur 2)
        For i = 3 To .UsedRange.Rows.Count Step 2
 
            ' on redimensionne la plage en y ajoutant la ligne
            Set Plage = Union(Plage, .Range(.Cells(i, 1), .Cells(i, .UsedRange.Columns.Count)))
        Next i
 
        ' liste sans doublon des dates, triées par ordre croissant
        ' on utilise deux fonctions perso :
        ' - SansDoublon qui va renvoyer une Chaine avec toutes les dates, séparée par un "$"
        ' - On splite SansDoublon pour mettre chaque valeur qui est entourée par des "$" dans un tableau ListeDate
        ' - TriDate va trier par ordre chronologique les éléments du tableau ListeDate
        ListeDate = TriDate(Split(SansDoublon(Plage, "$"), "$"))
 
        ' boucle sur chaque ligne de date
        For i = 1 To .UsedRange.Rows.Count Step 2
 
            ' écriture des dates dans la feuille de destination
            ' on écrit la première date dans la colonne A à la main, avec mise en forme selon ton format de date visible sur ta capture écran
            ' (en fait, la fonction TriDate doit être améliorée ... la date la plus récente est en dernière position !)
            ' ListeDate(UBound(ListeDate) donne la dernière date du tableau trié
            ShDest.Cells(i, 1) = Format(ListeDate(UBound(ListeDate)), "[$-40C]dd-mmm-yy;@")
 
            ' ensuite on rempli avec cette boucle les dates suivantes
            ' pour écarter la dernière date du tableau (qui est la date la plus récente qu'on a écrit au dessus) : on boucle jusqu'au dernier éléments - 1
            ' UBound(ListeDate) - 1
            ' on doit ajouter 2 à la variable j car :
            ' le tableau commence à l'indice 0, alors que la première cellule commence à 1 : il faut ajouter 1
            ' comme on a déjà écrit la première date, on doit décaler le pas d'écriture de 1 : il faut encore ajouter 1
            For j = LBound(ListeDate) To UBound(ListeDate) - 1
                ShDest.Cells(i, j + 2) = Format(ListeDate(j), "[$-40C]dd-mmm-yy;@")
            Next j
 
            NbColDest = ShDest.UsedRange.Columns.Count
 
            ' t va permettre de balayer les colonnes de la feuille où on écrit les résultats
            t = 1
 
            ' pour chaque colonne de la feuille où on écrit les résultats
            For j = 1 To NbColDest
                ' jusqu'à ce qu'on ai rempli toutes les colonnes
                Do Until t > NbColDest
 
                    ' si la date de la feuille source est différente de la feuille où on écrit
                    ' ça veut dire qu'on est sur une date qui n'existait pas : on écrit 0 en valeur sur la ligne d'en dessous
                    ' on décale la colonne d'écriture en incrémentant t
                    If CDate(.Cells(i, j)) <> CDate(ShDest.Cells(i, t)) Then
                        ShDest.Cells(i + 1, t) = 0
                        t = t + 1
 
                    ' si les deux dates sont égales
                    ' écriture du pourcentage pour les dates existantes
                    ' on décale la colonne d'écriture et on quitte la boucle Do pour changer de colonne d'inspection dans la feuille qu'on analyse
                    Else
                        ShDest.Cells(i + 1, t) = .Cells(i + 1, j)
                        t = t + 1
                        Exit Do
                    End If
                Loop
            Next j
 
            ' on applique le format pourcentage voulu sur la ligne complète quand on a fini de la remplir
            ShDest.Range(ShDest.Cells(i + 1, 1), ShDest.Cells(i + 1, NbColDest)).NumberFormat = "0%00"
 
        Next i
    End With
 
    ' on décharge les variables pour libérer la mémoire
    Set Plage = Nothing
    Set ShDest = Nothing
    Set ShSource = Nothing
 
End Sub

09/04/2015, 16h28
eric4459

Joe
Merci pour ton aide,les commentaires sur ton code me permettront en effet de mieux comprendre et de pouvoir assimiler ces nouvelles notions pour moi.
Dans un premier temps je vais abandonner la méthode Couper/Coller et je vais utiliser le Copier/coller, j'ai fais des tests et n'ai plus de problèmes d'Offset, reste à optimiser pour tous les cas possible sur lesquels je pourrais tomber.
Je suis conscient que ton code est bien mieux que ce que je vais réaliser, mais j'aime comprendre ce que j'utilise. Je vais donc m'obstiner :pc: avec ma méthode et tenter de parvenir à mes fins, puis j'essayerai de reproduire ce que tu as fait, nous sommes ici pour partager mais aussi pour évoluer ;).
Eric
09/04/2015, 19h38
joe.levrai

Excellente initiative !

Je me suis bien amusé à coder ma proposition, donc même si tu ne l'utilises pas ça me dérange pas.

Maintenant, si tu as des soucis pour ta procédure personnelle avec Copier/Coller, continue sur ce fil et indique les problèmes

Idem pour ma proposition, si t'as besoin de lumières supplémentaires.
Elle est pas super compliquée, faut juste comprendre la mécanique et potasser le tutoriel qui présente la manipulation des tableaux (surtout les notions d'indices, Ubound, Lbound et compagnie)

c'est avec ça que j'ai fais mes premières armes sur les Tableaux :mrgreen: : http://silkyroad.developpez.com/vba/tableaux/
10/04/2015, 00h31
eriiic
Bonjour,

Ce que je comprend pas c'est que tu arrives à faire tourner ton code sans erreur.
Code:

1 2 3 4 Range(Bsl.Offset(i, j), Bsl.Offset(i, j + 5).End(xlToRight).End(xlDown)).Cut Bsl.Offset(i, j + 1).Select ActiveSheet.Paste Bsl.Offset(i, j) = Bsl.Offset(i + 5, j)
J'ai tenté de tester mais :
1 : avec i=0 et j=0 au départ, tu coupes 6:10
2 : tu sélectionnes Bsl.[B6], donc Bsl est la feuille active
3 : et là tu cherches donc à coller dans la partie coupée ce qui génère une erreur.

J'ai raté quoi ?
Si tu avais un fichier de travail...

eric
10/04/2015, 09h55
eric4459

Citation:

Envoyé par eriiic

Bonjour,

Ce que je comprend pas c'est que tu arrives à faire tourner ton code sans erreur.

J'ai raté quoi ?
Si tu avais un fichier de travail...

eric

Bonjour Eric,
En fait cette méthode ne générait pas d’erreur au sens propre, avec plantage de VBA, mais décalait ma référence.
Une fois coupée ma série à partir d'Offset(i,j) , soit ma colonne A, et collée à partir de Offset(i, j+1), donc colonne B, la boucle suivante considérait ma référence Offset(i,j) non plus en colonne A mais en colonne B et ce sans que je ne lui ai indiqué quoi que ce soit.
Ne comprenant pas pourquoi ce décalage sauvage s'effectuait, j'ai tenté de passer à une autre méthode, méthode sur laquelle je ne vais pas m'attarder car le code fourni pas joe.levrai est super efficace (encore merci joe ;) ).
Je vais donc étudier le code fourni par joe, le tutoriel de Sylkyroad et revoir mes certitudes et autres a priori .
Etant donné que je manipule de nombreuses données de même type il semblerai que ce soit la meilleure option.
Eric
10/04/2015, 13h41
eriiic

Re,

J'avais bien compris ta question.
Et c'est parce que tu voulais comprendre le pourquoi du comment que j'ai voulu chercher. Et je maintiens l'erreur que ça me donne.
Mais comme tu adoptes maintenant la proposition de joe laissons donc.

eric
10/04/2015, 14h10
eric4459

Rebonjour Eric,
Merci d'avoir cherché à m'aider pour ce problème :ccool:
Cependant, je me suis aperçu que ce que j'essayais de faire allait devenir une "usine à gaz", chose que j'ai déjà réalisé par ailleurs sur une autre macro.
Je crois qu'il est temps pour moi de plonger sérieusement dans les tutos sur les tableaux et ainsi de pouvoir simplifier grandement mes codes à venir, et revenir sur mes "usines à gaz" ;)
Mon attitude est un peu défaitiste dans un sens, mais dans l'autre c'est aussi une prise de conscience de mon obstination et de ma nécessité d'évoluer.
Eric ;)

Bonjour le Forum,
Je suis parvenu à mes fins, ce que j'ai compris c'est qu'à chaque cut/paste ou Insert Shift:=xlToRight d'une cellule utilisée en Offset, celui-ci se déplaçait d'autant :
-Si mon offset est référencé en A1 et je ce coupe/colle ou décale 3 colonnes plus loin, ma référence se décalera d'autant.
J'ai trouvé une parade, en autre parade je suppose, qui est de référencer à nouveau après chaque action.
Voici mon code final dont le but est de mettre à une même date de départ toute une série de donnée.
Joe, dis-moi ce que tu en penses, il est surement possible de pouvoir se passer d'une feuille supplémentaire, peut-être en utilisant un autre tableau mais je ne suis pas sur.

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
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
Sub Update_Data_Date()
Dim Baseline As Worksheet
Dim Trment As Worksheet
Dim Bsl As Range
Dim TR As Range
Dim MyTab() As String
Dim MTab  As Integer
Dim LastCol As Integer
Dim NbLine As Integer
Dim NbFile As Integer
Dim DeCol As Integer
Dim i As Integer
Dim j As Integer
Dim x As Integer
Set Baseline = ThisWorkbook.Sheets("Baseline")
Set Trment = ThisWorkbook.Sheets("Treatment")
Set TR = Trment.Range("A1")
Set Bsl = Baseline.Range("A1")
 
    With Sheets("Baseline")
         LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column  ' On compte le nombre de colonne de l'onglet Baseline
    End With
 
    With Sheets("Baseline")
        NbLine = .Cells(.Rows.Count, 1).End(xlUp).Row - 1 ' On compte le nombre de ligne
    End With
 
    NbFile = NbLine / 5
 
    ReDim MyTab(0 To NbLine, 0 To LastCol)
 
    For i = 0 To UBound(MyTab, 1) Step 5
        MyTab(i, j) = Bsl.Offset(i, j)
        TR.Offset(i + 1, 2) = Month(MyTab(i, j)) & "-" & "01" & "-" & Year(MyTab(i, j)) 'Ici on met la date de la première cellulle
        TR.Offset(i + 1, 2).NumberFormat = "[$-410]dd-mmm-yy;@"
        TR.Offset(i + 1, 5).FormulaR1C1 = "=R[0]C[-3]-R1C3" ' Ici on met en cellule F"i+1" la formule : =C"i+1" -C$1$ pour calculer le nb de jour entre la date de
                                                            ' la première cellule et la date la plus ancienne de la feuille
    Next i
 
        TR.Offset(0, 2).FormulaR1C1 = "=MIN(R[1]C:R[" & NbLine - 3 & "]C)" 'Ici on met en cellule C1 la formule pour trouver la date la plus ancienne = MIN (C2:C"NbLine -3")
        TR.Offset(0, 2).NumberFormat = "0000"
 
 i = 0
 j = 0
 
  Do While Bsl.Offset(i, 0) <> ""
 
            DeCol = Int(TR.Offset(i + 1, 5) / 30) ' Ici on calcule le rapport entre Nb de jour pour décaler le nb de colonne nécessaire(ex si en F2 on a 91 DeCol sera égal à 3, on décalera de 3 Colonne)
 
        If Bsl.Offset(i, j) <> Bsl.Offset(i + 5, j) And DeCol <> 0 Then
           Range(Bsl.Offset(i, j), Bsl.Offset(i + 4, j + DeCol - 1)).Insert Shift:=xlToRight ' Ici on décale du nb de cellule nécessaire
           Set Bsl = Baseline.Range("A1")
           For j = 0 To DeCol - 1
                Bsl.Offset(i, j).Select
                If Bsl.Offset(i, 0) = "" Then
                MTab = Month(TR.Range("C1"))
                Else
                MTab = Month(Bsl.Offset(i, j - 1))
                End If
                If MTab = 4 Or MTab = 6 Or MTab = 9 Or MTab = 11 Then
                x = 30
                ElseIf MTab = 2 Then
                x = 28
                Else
                x = 31
                End If
 
                  If j = 0 Then
                  Bsl.Offset(i, j) = TR.Range("C1")
                  Else
                  Bsl.Offset(i, j) = Bsl.Offset(i, j - 1) + x
                  End If
                  Bsl.Offset(i, j).NumberFormat = "[$-410]mmm-yy;@"
                  Bsl.Offset(i + 1, j) = 0
                  Bsl.Offset(i + 1, j).NumberFormat = "0.00%"
                  Bsl.Offset(i + 2, j) = 0
                  Bsl.Offset(i + 2, j).NumberFormat = "0.00%"
                  Bsl.Offset(i + 3, j) = 0
                  Bsl.Offset(i + 3, j).NumberFormat = "€ 0.00"
                  Bsl.Offset(i + 4, j) = 0
                  Bsl.Offset(i + 4, j).NumberFormat = "€ 0.00"
           Next j
 
 
        End If
        i = i + 5
        j = 0
  Loop
 
End Sub

Eric