Copier des cellules dans une autre feuille avec critères

Bonjour à toutes et à tous,

Je ne suis pas un expert Excel et je remercie par avance tous ceux qui pourront m'apporter un soutien.

Lorsque j’en saurai un peu plus alors je pourrais à mon tour transmettre aux autres.

Mon problème et le suivant /

J'ai une feuille excel avec des datas qui débutent en A7 et qui vont jusqu'en AU 115.

Toutes les lignes ne sont pas renseignées, mais devraient l'être plus tard.

Ma première feuille qui porte le nom de 2020 contient des données que je vais devoir copier sur une autre feuille nommée 2021 une autre 2022 ...

J'ai besoin d'une macro qui va intégrer d'abord de 2020 a7:au115 à 2021 puis de 2021 à 2022... tout ça automatiquement avec plusieurs critères :

Ma cellule 2020 g7 contient une date qui devra être strictement supérieur à la date contenue dans la cellule $L$3 de 2021 OU que la cellule 2020 k7 est aussi strictement > $L$3 pour copier la ligne dans 2021

Pour la feuille 2022 on fait la même chose mais avec les cellule 2021 vers 2022.

Jai commencé un VBA mais il ne fonctionne qu'à moité, il recopie bien mais sur les cellules à partir de a1 sur 2021.

Sub copie_2021()
Dim plage As Range, cel As Range, derlig, derlig1

'fige ecran
Application.ScreenUpdating = False
With Worksheets("2020")
'derniere cellule non vide colonne A
derlig = .Range("A7" & Rows.Count).End(xlUp).Row
'mise en memoire plage donnees
Set plage = .Range("g7" & derlig)
'boucle test cellule Gx > $L3
For Each cel In plage
If cel > "$l3" Then
'premiere cellule vide colonne A
'derlig1 = Worksheets("2021").Range("A" & Rows.Count).End(xlUp).Row + 1
'copy donnees
.Range("A7" & cel.Row & ":AU" & cel.Row).Copy Worksheets("2021").Range("A" & derlig1 & ":AU" & derlig1)
End If
Next cel
End With
Application.ScreenUpdating = True
End Sub

SI une petite main peut me venir en aide ce serait top.

Merci par avance

Portez vous bien

François

Bonjour François et bienvenu, bonjour le forum,

Un petit fichier exemple reprenant la structure de l'original avec quelques dizaine de données nous permettra de mieux comprendre, de tester et de te proposer éventuellement une solution...

Merci à toi pour l'aide que tu peux m'apporter.

Tu trouveras le fichier jointLe but étant de recopier les lignes de la feuille 2020 à partir de a7 jusqu'à au7 sur la feuille 2021 si la date en colonne G de 2020 est supérieure à la date sur la feuille 2021 en L3 ou si la date en k est supérieure à la date de la feuille 2021 en L3.

On fait la même chose en entre 2021 et 2022 et par la suite 2023 jusqu'à 2027.

Merci pour ton aide

François

Bonjour Frmany, bonjour le forum,

Je n'ai pas compris le b***el qu'il y avait à partir des lignes 119 de l'onglet 2021... Une proposition à tester :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim OT As Worksheet 'déclare la variable OT (Onglet de Travail)
Dim A As Integer 'déclare la variable A (Année)
Dim OS As Worksheet 'déclare la variable OS (Onglet Suivant)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim DR As Date 'déclare la variable DR (Date de Référence)
Dim I As Integer 'déclare la variable I (Incrément)
Dim D1 As Date 'déclare la variable D1 (Date 1)
Dim D2 As Date 'déclare la variable D2 (Date 2)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
For Each O In Worksheets 'boucle 1 : sur tous les onglets O du classeur
    Set OT = O 'définit l'onglet de travail OT
    OT.Activate 'active l'onglet
    A = CInt(OT.Name) 'définit l'année A
    TV = OT.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante
    'exécute jusqu'à ce que le nom l'onglet actif soit égale à A+1 (génère une erreur si c'est le dernier onglet du classeur)
    Do Until ActiveSheet.Name = A + 1
        If Err <> 0 Then 'condition si une erreur a été générée
            Err.Clear 'supprime l'erreur
            Exit Sub 'sort de la procédure
        End If 'fin de la condition
        Set OS = ActiveSheet.Next 'définit l'onglet suivant OS
        OS.Activate 'active l'onglet OS
    Loop 'boucle
    DR = CDate(OS.Range("L3").Value) 'définit la date de référence (L3 de l'onglet OS)
    For I = 7 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeur (en partant de la 7ème)
        D1 = CDate(TV(I, 7)) 'définit la date D1 (en colonne G)
        D2 = CDate(TV(I, 11)) 'définit la date D2 (en colonne K)
        If D1 > DR Or D2 > DR Then 'si D1 ou D2 est suprérieure à la date de référence DR
            Set DEST = OS.Range("A119").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
            'renvoie dans DEST redimensionnée la ligne I du tableau des valeurs TV
            DEST.Resize(1, UBound(TV, 2)).Value = Application.Index(TV, I)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
Next O 'prochain onglet de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Merci ThauThème.

Je vais essayer et comparer ton trtavail avec celui de FFO.

Merci à vous deux

Je vous tiens au courant

François

Re,

Arf !.. C'était une compétition !?... M***e...

ThauThème,

J'ai unne erreur à l'éxécution su rla ligne :

A = CInt(OT.Name) 'définit l'année A

OT doit être la première feuille avec une date : soit 2020.

Re,

Il n'y aurait pas une espace avant 2020 ou après ou les deux ?...

Nop my dear...

François

Re,

Je n'ai pas ce problème chez moi avec ton fichier exemple :

Re,

Je crois comprendre. Ton exemple ne reflète pas la réalité de ton classeur. Il y a des onglets qui ne sont pas des années. C'est pour ça que ça plante... J'espère que FFO résoudra ton problème...

ThauThème,

Je te remercie chaleureusement pour ton aide.

Effectivement le problème est maintenant résolu. Ça fonctionne !!!!

Merci pour ta contribution.

Porte toi bien

François