Copier coller en fonction des dates

Version imprimable

01/12/2011, 14h10
hortencia

Copier coller en fonction des dates

Bonjour a tous,

Est ce quelqu'un saurait comment faire pour copier les données d'une colonne, d'une année à l'autre.
En colonne A j'ai des dates du 1er Janvier 2011 à l' "infini".

J'aimerais copier les données qu'il y a sur la colonne A du 1er Janvier 2011 au 31 Décembre 2011, toujours sur la colonne A mais du 1er Janvier 2012 au 31 Décembre 2012.

Et c'est là que ça se complique je voudrais le généraliser.
Si je lance ma macro en 2012, il devrait copier les données de 2011 sur 2012.
Si je lance ma macro en 2013, il devrait copier les données de 2012 sur 2013.

Je ne sais pas si c'est claire.
Rien qu'en l'énonçant, ça me parait infaisable !!!!!!

Quelqu'un aurait t-il une solution à me proposer ?

Trés cordialement.
01/12/2011, 14h24
redstoff

Bonjour,

Je pense que c'est possible, mais pour moi j'aurais besoin de plus d'information.

Peux tu mettre une photo de ton fichier ou ton fichier directement pour que je puisse regarder
01/12/2011, 15h05
hortencia

1 pièce(s) jointe(s)

Merci de ta réponse
Excuse moi je viens à peine de la voir.

Voila le fichier test.

Il y a des dates en colonne A.
Et de données en fonction des dates en colonne B.
Le tout sur l'année 2010.

Merci de ton aide.
Trés sincèrement.

Essaie ce code, il fonctionne si les dates sont toujours dans l'ordre :

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
Option Explicit
 
Public Sub test()
    copieAnnee 2010, 2011
End Sub
 
Public Sub copieAnnee(ByVal anneeSource As Integer, ByVal anneeCopie As Integer)
    Dim firstRow, lastRow, corresRow, i As Integer
    Dim rg As Range
    Set rg = Worksheets("Feuil1").Range("A:A")
    Dim dt As Date
 
    firstRow = WorksheetFunction.Match(CDbl(DateSerial(anneeSource, 1, 1)), rg, 1)
    lastRow = WorksheetFunction.Match(CDbl(DateSerial(anneeSource, 12, 31)), rg, 1)
    If Year(rg.Cells(firstRow, 1)) < anneeSource Then firstRow = firstRow + 1
 
    For i = firstRow To lastRow
        dt = rg.Cells(i, 1).Value
        On Error Resume Next
        corresRow = WorksheetFunction.Match(CDbl(DateAdd("yyyy", 1, dt)), rg, 0)
        If Err.Number = 0 Then
            rg.Cells(corresRow, 1).Offset(0, 1).Value = rg.Cells(i, 1).Offset(0, 1).Value
        End If
        On Error GoTo 0
    Next i
End Sub

01/12/2011, 16h06
hortencia
Merci beaucoup, cela fonctionne parfaitement bien.
C'est géniale. :ccool:

Est ce que ce serait possible que tu m'explique un peu le code.
Je ne comprends pas bien le fonctionnement. Excuse moi.

Cela ne marche que de 2010 à 2011 où puis je le généraliser ?

Trés Cordialement.

Je crois comprendre.
Je ne peux pas le généraliser, mais si je souhaite copier de 2011 à 2012 il me suffit de modifier, de la sorte :
Code:

1 2 3 4 5 Option Explicit Public Sub test() copieAnnee 2011, 2012 End Sub
C'est ça?
Excuse moi, je ne sais pas encore trés bien coder.
Cordialement.

Ca marchera pour n'importe quelle année, pourvu qu'elle soit dans ta colonne. Voici quelques explications :

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
Option Explicit 'Comme ça, erreur à la compilation si des variables ne sont pas déclarées. Réduit le risque d'erreur par la suite
 
'Appel de la fonction pour copier 2010 sur 2011
'On peut choisir n'importe quelles valeurs pour les deux années du moment que l'année source est dans la feuille.
Public Sub test()
    copieAnnee 2010, 2011
End Sub
 
'La procédure de copie
Public Sub copieAnnee(ByVal anneeSource As Integer, ByVal anneeCopie As Integer)
    Dim firstRow, lastRow, corresRow, i As Integer
    Dim rg As Range
    Set rg = Worksheets("Feuil1").Range("A:A")
    Dim dt As Date
 
    'Donne la ligne de la plus grande date inférieure ou égale au 1er janvier de l'année source
    firstRow = WorksheetFunction.Match(CDbl(DateSerial(anneeSource, 1, 1)), rg, 1)
    'Donne la ligne de la plus grande date inférieure ou égale au 31 décembre de l'année source
    lastRow = WorksheetFunction.Match(CDbl(DateSerial(anneeSource, 12, 31)), rg, 1)
    'Si le 1er janvier n'existait pas, on récupère la première date de l'année. C'est surtout pour si un jour tu enlèves les WE par exemple.
    If Year(rg.Cells(firstRow, 1)) < anneeSource Then firstRow = firstRow + 1
 
    'Pour chaque date dans l'année source
    For i = firstRow To lastRow
        dt = rg.Cells(i, 1).Value
        On Error Resume Next 'Indique qu'en cas d'erreur, on continue
        'On cherche s'il existe la même date pour l'année cible. Actuellement, on l'a forcément à part le 29 février
        corresRow = WorksheetFunction.Match(CDbl(DateAdd("yyyy", 1, dt)), rg, 0)
        If Err.Number = 0 Then 'S'il n'y a pas eu d'erreur, il a trouvé la date demandée
            rg.Cells(corresRow, 1).Offset(0, 1).Value = rg.Cells(i, 1).Offset(0, 1).Value 'On recopie la valeur, Offset fait ici un décalage d'une colonne vers la droite
        End If
        On Error GoTo 0 'On réenclenche la gestion normale des erreurs
    Next i
End Sub

01/12/2011, 16h48
hortencia

Merci infiniment.
Et merci aussi pour les explications.

Mais j'ai juste une dernière question.
Je n'avais pas pensé aux année bissextiles.

Je ne suis pas sur d'avoir compris.
Est ce que cela est traité (ie : les données sont copiées sur 365 jours au lieu de 366), ou est ce que si l'année est bissextile la macro ne fonctionne pas?

De plus je suis sotte effectivement il faut que je saute les week end, il faut que ça copie et décale sur jours ouvrés.

Exemple : si ça tombe un dimanche il faut que ça copie à vendredi d'avant.``

Pffffff!!!!! Je suis sotte. J'avais même pas pensé à cela, ce sont tes commentaires sur le code qui m' y ont fait penser.

Merci encore de m'aider.

Trés sincèrement.
01/12/2011, 17h22
ZebreLoup

Alors comme tu as pu le voir, si je suis par exemple au 30 octobre 2011, je vais voir si le 30 octobre 2012 existe et je recopie la valeur.
Si tu veux recopier 2012 dans 2013, la macro va marcher mais effectivement la valeur du 29 février 2012 ne sera recopiée nulle part car il n'y a pas de 29 février 2013.

Maintenant, si tu veux enlever les WE de ta liste de date, ça va se compliquer. Avec le code actuel, tu vas perdre beaucoup de valeurs. Il faut donc l'adapter mais il faut d'abord que tu décides ce qu'il faut faire (sans parler de programmation). Si tu te contentes de revenir au vendredi si c'est un WE, d'autres problèmes vont se poser (arrivé au dimanche, tu vas écraser la valeur du samedi qui aura écrasée la valeur du vendredi). Je ne peux pas t'aider sur ce point vu que je ne sais pas quel est le but de ton fichier et à quoi correspondent les chiffres de la colonne B.
01/12/2011, 17h43
hortencia

Merci beaucoup ZebreLoup.

As ton avis serait t-il possible de copier les valeurs mais sans impliquer les dates?

C'est a dire par exemple chercher la ligne correspondante au 1er Janvier de l'année précédente.

Exemple : la ligne 5.

Puis de copier les 365 lignes suivantes pour une année normale.
Exemple : les lignes 5 à 370.

De cette manière seront copier toutes les données non ?

Trés cordialement.

C'est plus simple dans ce cas, sauf pour les années bissextiles, mais le mieux c'est peut-être de ne pas afficher les 29 février du coup ?

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
Option Explicit 'Comme ça, erreur à la compilation si des variables ne sont pas déclarées. Réduit le risque d'erreur par la suite
 
'Appel de la fonction pour copier 2010 sur 2011
'On peut choisir n'importe quelles valeurs pour les deux années du moment que l'année source est dans la feuille.
Public Sub test()
    copieAnnee 2010, 2011
End Sub
 
'La procédure de copie
Public Sub copieAnnee(ByVal anneeSource As Integer, ByVal anneeCopie As Integer)
    Dim firstRow, corresRow As Integer
    Dim rg As Range
    Set rg = Worksheets("Feuil1").Range("A:A")
    Dim dt As Date
 
    'Donne la ligne de la plus grande date inférieure ou égale au 1er janvier de l'année source
    firstRow = WorksheetFunction.Match(CDbl(DateSerial(anneeSource, 1, 1)), rg, 0)
 
    'Ligne pour l'année d'après
    dt = rg.Cells(firstRow, 1).Value
    corresRow = WorksheetFunction.Match(CDbl(DateAdd("yyyy", 1, dt)), rg, 0)
 
    'Copie
    rg.Range(rg.Cells(corresRow, 1), rg.Cells(corresRow + 364, 1)).Value = rg.Range(rg.Cells(firstRow, 1), rg.Cells(firstRow + 364, 1)).Value
End Sub

01/12/2011, 18h48
hortencia

Merci infiniment ZebreLoup.
T'es génial. C'est parfait.

Je vais faire de la sorte, tu as raison.
Inutile de prendre compte les dates pour la copie-colle.

Mais est ce que tu aurais une idée de la manière dont je pourrais gérer les week end après avoir copier coller le tout.

Penses tu qu'il serait possible de balayer cette plage et de décaler les données qui seraient sur les samedis et Dimanches ou est ce une tâche impossible ?

Encore merci de ton aide.
Je te pose beaucoup de question, et ça doit te mettre un certain temps de te poser sur mes problématiques.
Merci beaucoup de m'accorder autant d'aide et autant de temps.

Trés cordialement.
02/12/2011, 10h51
ZebreLoup

Pas de problème, c'était une semaine un peu "creuse" au boulot ! Par contre, je vais avoir moins de temps maintenant.
Tu peux essayer de regarder le premier code que je t'avais fourni. Si tu comprends bien en détail tout ce qu'il fait et que tu lis quelques tutos VBA, tu pourras l'adapter à ce que tu veux faire facilement.