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

ThauTheme Messages postés 1442 Date d'inscription   Statut Membre Dernière intervention   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
Billy
 
Merci beaucoup a toi.

Et merci a CCM.
0