Repartition par onglet

billy -  
 Billy -
bonjour,

Je souhaiterais repartir les infos de la première feuille (une centaine de ligne), dans les feuilles correspondantes en fonction du nom de l'element (le nombre d'element peut varier de 1 à 10 environ). voir exemple sur le document joint.

Cependant je n'y connait rien en programmation. si quelque peut m'aider pour une solution.

http://www.cjoint.com/15av/EDdwSylhOle.htm

merci D'avance

2 réponses

  1. ThauTheme Messages postés 1564 Statut Membre 160
     
    Bonsoir Billy, bonsoir le forum,

    Peut-être comme ça :

    Sub Macro1()
    Dim OI As Worksheet 'déclare la variable OI (Onglet Infos)
    Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
    Dim O As Worksheet 'déclare la variable O (Onglets)
    Dim I As Integer 'déclare la variable I (Incrément de ligne)
    Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
    Dim DEST As Range 'déclare la variable DEST(cellule de DESTination)
            
    Set OI = Sheets("Infos") 'définit l'onglet  OI
    TC = OI.Range("A1").CurrentRegion 'définit le tableau de cellules TC
    
    'première boucle pour supprimer les anciennes données et mettre en place les en-têtes
    For Each O In Sheets 'boucle sur tous les onglets O du classeur
        If Not O.Name = "Infos" Then 'condition : si le nom de l'onglet n'est pas "infos"
            O.Cells.ClearContents 'vide le contenu de l'onglet
            O.Range("A1").Value = "litre" 'écrit "litre" en A1
            O.Range("B1").Value = "heure" 'écrit "heure" en B1
            O.Range("C1").Value = "conso" 'écrit "conso" en C1
            O.Range("D1").Value = "activité" 'écrit "activité" en D1
        End If 'fin de la condition
    Next O 'prochain onglet de la boucle
    
    'boucle 2 pour dispatcher les données dans les onglets correspondants
    For I = 3 To UBound(TC, 1) 'boucle sur toutes les lignes I du tableau TC (en partant de la troisième)
        Set OD = Sheets(TC(I, 3)) 'définit l'onglet de destination OD
        Set DEST = OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellue de destination DEST
        DEST.Value = TC(I, 2) 'récupère le litre dans DEST
        DEST.Offset(0, 1).Value = TC(I, 4) 'récupère l'heure dans DEST décalée d'une colonne à droite
        DEST.Offset(0, 3).Value = TC(I, 5) 'récupère l'activité dans DEST décalée de trois colonnes à droite
    Next I 'prochaine ligne de la boucle
    
    'boucle 3 pour les formules
    For Each O In Sheets 'boucle 1 : sur toutes les lignes I du tableau TC (en partant de la troisième)
        If Not O.Name = "Infos" Then 'condition 1 : si le nom de l'onglet n'est pas "infos"
            'définit la dernière ligne éditée Dl de la colonn e1 (=A) de l'onglet O
            DL = O.Cells(Application.Rows.Count, 1).End(xlUp).Row
            If DL = 1 Then Exit Sub 'si DL=1, sort de la procédure
            If DL > 1 Then 'condition 2 : si DL est supérieure à 1
                O.Cells(2, 3).Value = "/" 'place le slash (/) dans la ligne 2 colonne 3 (=C)
                If DL > 2 Then 'condition 3 : si Dl est supérieure à 2
                    For I = 3 To DL 'boucle 2 : de 3 à DL
                        'place la formule dans la cellule ligne I colonne 3 (=C)
                        O.Cells(I, 3).FormulaR1C1 = "=RC[-2]/(RC[-1]-R[-1]C[-1])"
                    Next I 'prochaine ligne de la boucle
                End If 'fin de la condition 3
            End If 'fin de la condition 2
        End If 'fin de la condition 1
    Next O 'prochain onglet de la boucle
    End Sub

    0
  2. Billy
     
    Merci beaucoup a toi.

    Et merci a CCM.
    0