Copier des cellules dans une autre feuille si condition

chevalpm

XLDnaute Nouveau
Bonjour,

Voilà je suis en pleine prise de tête sur la programmation de mon tableau. J'espère pouvoir trouver une aide sur ce forum.
Mon problème est le suivant : j'ai 4 feuilles, les 2 premières "MARS""MERCURE" pour la récolte des informations et les 2 dernières "AF MARS""AF MERCURE" pour le traitement des infos (graphique,...)
Je voudrais donc que quand une valeur est écrite dans la colonne G (Feuille MARS) (il s'agit d'une valeur incrémentée) les infos des colonnes A, B, C, D et G de la feuille "MARS" se mettent automatiquement dans la feuille "AF MARS". Respectivement dans les colonnes B, C, D, E et A de la feuille "AF MARS", de même pour les feuilles "MERCURE" et "AF MERCURE".
Je vous joint le tableau en pj.


J'espère que vous pourrez m'aider.

Merci par avance.
 

Pièces jointes

  • EXEMPLE EXCELDOWNLOADS.xlsx
    33.1 KB · Affichages: 41

Robert

XLDnaute Barbatruc
Repose en paix
Re : Copier des cellules dans une autre feuille si condition

Bonjour Chevalpm, bonjour le forum,

Peut-être comme ça :
Code:
Sub Macro1()
Dim o As Object 'déclare la variable o (Onglet)
Dim od As Object 'déclare la variable od (Onglet de Destination)
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim ad As Range 'déclare la variable ad (Anciennes Données)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)

For Each o In Sheets 'boucle 1 : sur tous les onglets du classeur
    Select Case o.Name 'agit en fonction du nom de l'onglet de la boucle
        Case "MARS", "MERCURE" 'cas "MARS" et MERCURE"

            
            '****************************
            'efface les anciennes données
            '****************************
            Set od = Sheets("AF " & o.Name) 'définit l'onglet de destination
            Set ad = od.Range("A4").CurrentRegion 'définit la plage des anciennes données
            If ad.Rows.Count > 3 Then 'condition : si la plage contient plus de 3 lignes
                Set ad = ad.Offset(3, 0).Resize(ad.Rows.Count - 3, ad.Columns.Count) 'redéfinit la plage des anciennes données (sans les 3 pemières lignes)
                ad.Clear 'efface TOUT dans la plage ad
            End If 'fin de la condition
            
            
            '******************************
            'Extrait les donnés de l'onglet
            '******************************
            With o 'prend en compte l'onglet o de la boucle
                dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 1 (=A)
                Set pl = .Range("G3:G" & dl) 'définit la plage pl
                For Each cel In pl 'boucle 2 sur toutes les cellules cel de la plage pl
                    If cel.Value <> "" Then 'condition : si la cellule cel n'est pas vide
                        'définit la cellule de destination (A5, si A5 est vide , sinon la pemière cellule vide de la colonne A)
                        Set dest = IIf(od.Range("A5").Value = "", od.Range("A5"), od.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
                        cel.Copy dest 'copie et colle la cellule dans dest
                        cel.Offset(0, -6).Resize(, 5).Copy dest.Offset(0, 1) 'copie les 5 premières cellules de cel dans dest décalée d'un colonne à droite
                    End If 'fin de la condition
                Next cel 'prochaine cellule de la boucle 2
            End With 'fin de la prise en compte de l'onglet o de la boucle
    End Select 'fin de l'action en fonction du nom de l'onglet de la boucle
Next o 'prochain onglet de la boucle 1
End Sub
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 379
Messages
2 087 769
Membres
103 662
dernier inscrit
rterterert