Extraire automatiquement des données

Bonjour à tous,

En VBA, Serais t'il possible à l'ouverture du fichier, de créer une sheets pour chaque projet existant dans la colonne "projet" de la feuille "info". Ensuite que chaque feuille soit incrémentées des infos ligne par ligne des colonnes qui m'intéresse comme pour la sheet "1129" en exemple dans le fichier joint et ce sachant que c'est sur des import donc que le nombre de ligne ne sera jamais le même. De plus une extraction auto de chaque "num de compte" dans la colonne "num.compte2" puis les totaux dans la colonne "totaux" et enfin le total des sommes en bas de colonne "taux act." et les totaux ligne par ligne de la multiplication entre la colonne "taux act." et la colonne "UTILISE" ?

J'ai conscience que je m'exprime peut être mal !

Merci à ceux qui me lirons et répondrons !

Bonjour Romain et bienvenu, bonjour le forum,

En pièce jointe ton fichier modifié mais inachevé car je n'ai rien compris à la fin.

À l'ouverture du fichier il commence par supprimer tous les onglets sauf INFO. Ensuite ils dispatche les données de chaque Projet. Mais pour ce qui est des totaux et autres il faudrait que tu sois plus clair...

Le code :

Private Sub Workbook_Open() 'a l'ouverture du fichier
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim PL() As Variant 'déclare la variable PL (Première Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim O As Worksheet 'déclare la variable O (Onglet)

Set OS = Worksheets("INFO") 'définit l'onglet source OS
'définit la premiere ligne PL
PL = Array("Date de début", "Date de fin", "Projet", "Sous-Famille", "REF", "UTILISE", "Taux Act.", "Total", "Num. compte", "Num.compte2", "totaux")
Application.DisplayAlerts = False 'interdit les messages de l'application Excel
For I = Sheets.Count To 1 Step -1 'boucle inversée du dernier onglet au premier
    If Not Sheets(I).Name = "INFO" Then Sheets(I).Delete 'si l'onglet ne se nomme pas "INFO", supprime l'onget
Next I 'prochain onglet de la boucle
Application.DisplayAlerts = True 'autorise les messages de l'application Excel
TV = OS.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 3) <> "" Then D(TV(I, 3)) = "" 'alimente le dictionnaire D avec les éléments de la colonne 3 de TV (Projet)
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublons (les clés)
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments J de TMP
    Erase TL: K = 0 'vide le tableau TL, réinitialise la variable K
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Set O = Worksheets(TMP(J)) 'définit l'onglet O (onglet de l'élément J de TMP), génère une erreur si cet onglet n'existe pas
    If Err > 0 Then 'condition : si une erreur a été générée
        Err.Clear 'supprime l'erreur
        Worksheets.Add After:=Sheets(Sheets.Count) 'ajoute un onglet vierge en dernière position
        Set O = ActiveSheet 'définit l'onglet O
        O.Name = TMP(J) 'renomme l'onglet O avec le nom de l'élément J de TMP
    End If 'fon de la condition
    On Error GoTo 0 'annule la gestion des erreurs
    O.Range("A1").Resize(1, 11).Value = PL 'renvoie la première ligne PL dans A1 redimensionnée de l'onglet O
    For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 3) = TMP(J) Then 'condition : si la donnée ligne I colonne 3 de TV est égale à l'élément J de TMP
            K = K + 1 'incrémente K
            ReDim Preserve TL(1 To 7, 1 To K) 'redimensionne le tableau des lignes TL (7 lignes, K colonnes)
            TL(1, K) = TV(I, 1) 'récupère dans la ligne 1 de TL la donnée en colonne 1 de TV (=> transposition)
            TL(2, K) = TV(I, 2) 'récupère dans la ligne 2 de TL la donnée en colonne 2 de TV (=> transposition)
            TL(3, K) = TV(I, 3) 'récupère dans la ligne 3 de TL la donnée en colonne 3 de TV (=> transposition)
            TL(4, K) = TV(I, 8) 'récupère dans la ligne 4 de TL la donnée en colonne 8 de TV (=> transposition)
            TL(5, K) = "" 'récupère du vide dans la ligne 5 de TL car je n'ai pas trouvé la colonne REF dans l'onglet OS...
            TL(6, K) = TV(I, 19) 'récupère dans la ligne 6 de TL la donnée en colonne 19 de TV (=> transposition)
            TL(7, K) = TV(I, 27) 'récupère dans la ligne 7 de TL la donnée en colonne 27 de TV (=> transposition)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle
    'si K est supérieure à zéro renvoie le tableau TL transposé dans la cellule A2 redimensionnée de l'onglet O
    If K > 0 Then O.Range("A2").Resize(K, 7).Value = Application.Transpose(TL)
Next J 'prochaine éléments de la boucle 1
End Sub

Le fichier :

9romain-ep-v01.xlsm (129.68 Ko)



Bonjour ThauThème et merci !

C'est super c'est ce que je voulais ! Pour les calculs en fait c'était pouvoir multiplier la ligne de la colonne "UTILISE" par la ligne "Taux Act." et résultat dans "Total". Ensuite prendre les infos de la colonne "V" de la feuille "info" et les reporter dans la colonne "I" de chaque nouvelle feuille.

Si tu as la solution se serait énorme !

Merci d'avance.

Re,

Oui c'est faisable mais je ne comprends pourquoi le Num.Compte2 dans le tableau du projet, ni non plus, où se trouve la colonne Ref dans l'onglet source.

[Édition]

Le nouveau code :

Private Sub Workbook_Open() 'a l'ouverture du fichier
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim PL() As Variant 'déclare la variable PL (Première Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim O As Worksheet 'déclare la variable O (Onglet)

Set OS = Worksheets("INFO") 'définit l'onglet source OS
'définit la premiere ligne PL
PL = Array("Date de début", "Date de fin", "Projet", "Sous-Famille", "REF", "UTILISE", "Taux Act.", "Total", "Num. compte", "Num.compte2", "totaux")
Application.DisplayAlerts = False 'interdit les messages de l'application Excel
For I = Sheets.Count To 1 Step -1 'boucle inversée du dernier onglet au premier
    If Not Sheets(I).Name = "INFO" Then Sheets(I).Delete 'si l'onglet ne se nomme pas "INFO", supprime l'onget
Next I 'prochain onglet de la boucle
Application.DisplayAlerts = True 'autorise les messages de l'application Excel
TV = OS.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 3) <> "" Then D(TV(I, 3)) = "" 'alimente le dictionnaire D avec les éléments de la colonne 3 de TV (Projet)
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublons (les clés)
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments J de TMP
    Erase TL: K = 0 'vide le tableau TL, réinitialise la variable K
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Set O = Worksheets(TMP(J)) 'définit l'onglet O (onglet de l'élément J de TMP), génère une erreur si cet onglet n'existe pas
    If Err > 0 Then 'condition : si une erreur a été générée
        Err.Clear 'supprime l'erreur
        Worksheets.Add After:=Sheets(Sheets.Count) 'ajoute un onglet vierge en dernière position
        Set O = ActiveSheet 'définit l'onglet O
        O.Name = TMP(J) 'renomme l'onglet O avec le nom de l'élément J de TMP
    End If 'fon de la condition
    On Error GoTo 0 'annule la gestion des erreurs
    O.Range("A1").Resize(1, 11).Value = PL 'renvoie la première ligne PL dans A1 redimensionnée de l'onglet O
    For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 3) = TMP(J) Then 'condition : si la donnée ligne I colonne 3 de TV est égale à l'élément J de TMP
            K = K + 1 'incrémente K
            ReDim Preserve TL(1 To 9, 1 To K) 'redimensionne le tableau des lignes TL (7 lignes, K colonnes)
            TL(1, K) = TV(I, 1) 'récupère dans la ligne 1 de TL la donnée en colonne 1 de TV (=> transposition)
            TL(2, K) = TV(I, 2) 'récupère dans la ligne 2 de TL la donnée en colonne 2 de TV (=> transposition)
            TL(3, K) = TV(I, 3) 'récupère dans la ligne 3 de TL la donnée en colonne 3 de TV (=> transposition)
            TL(4, K) = TV(I, 8) 'récupère dans la ligne 4 de TL la donnée en colonne 8 de TV (=> transposition)
            TL(5, K) = "" 'récupère du vide dans la ligne 5 de TL car je n'ai pas trouvé la colonne REF dans l'onglet OS...
            TL(6, K) = TV(I, 19) 'récupère dans la ligne 6 de TL la donnée en colonne 19 de TV (=> transposition)
            TL(7, K) = TV(I, 27) 'récupère dans la ligne 7 de TL la donnée en colonne 27 de TV (=> transposition)
            If TL(6, K) = "" Or TL(7, K) = "" Then TL(8, K) = "" Else TL(8, K) = CDbl(TL(6, K) * TL(7, K)) 'calcule dans la ligne 8 de TL
            TL(9, K) = TV(I, 22) 'récupère dans la ligne 9 de TL la donnée en colonne 22 de TV (=> transposition)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle
    'si K est supérieure à zéro renvoie le tableau TL transposé dans la cellule A2 redimensionnée de l'onglet O
    If K > 0 Then O.Range("A2").Resize(K, 9).Value = Application.Transpose(TL)
    O.Columns(9).HorizontalAlignment = xlRight
Next J 'prochaine éléments de la boucle 1
End Sub


"Num compte 2" me paraissait plus simple alors que c'est le même que "Num compte" et la colonne "Ref" correspond à la colonne "référence" de la feuille source.

Re ThauTheme,

Le code fonctionne il ne me reste plus qu'à reporter la colonne "référence" de la feuille "info" dans la colonne "REF" des nouvelles feuilles !

Les calculs fonctionnent super !

Merci encore !

Re,

Le code avec les références :

Private Sub Workbook_Open() 'a l'ouverture du fichier
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim PL() As Variant 'déclare la variable PL (Première Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim O As Worksheet 'déclare la variable O (Onglet)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set OS = Worksheets("INFO") 'définit l'onglet source OS
'définit la premiere ligne PL
PL = Array("Date de début", "Date de fin", "Projet", "Sous-Famille", "REF", "UTILISE", "Taux Act.", "Total", "Num. compte", "Num.compte2", "totaux")
Application.DisplayAlerts = False 'interdit les messages de l'application Excel
For I = Sheets.Count To 1 Step -1 'boucle inversée du dernier onglet au premier
    If Not Sheets(I).Name = "INFO" Then Sheets(I).Delete 'si l'onglet ne se nomme pas "INFO", supprime l'onget
Next I 'prochain onglet de la boucle
Application.DisplayAlerts = True 'autorise les messages de l'application Excel
TV = OS.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 3) <> "" Then D(TV(I, 3)) = "" 'alimente le dictionnaire D avec les éléments de la colonne 3 de TV (Projet)
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublons (les clés)
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments J de TMP
    Erase TL: K = 0 'vide le tableau TL, réinitialise la variable K
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Set O = Worksheets(TMP(J)) 'définit l'onglet O (onglet de l'élément J de TMP), génère une erreur si cet onglet n'existe pas
    If Err > 0 Then 'condition : si une erreur a été générée
        Err.Clear 'supprime l'erreur
        Worksheets.Add After:=Sheets(Sheets.Count) 'ajoute un onglet vierge en dernière position
        Set O = ActiveSheet 'définit l'onglet O
        O.Name = TMP(J) 'renomme l'onglet O avec le nom de l'élément J de TMP
    End If 'fon de la condition
    On Error GoTo 0 'annule la gestion des erreurs
    O.Range("A1").Resize(1, 11).Value = PL 'renvoie la première ligne PL dans A1 redimensionnée de l'onglet O
    For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 3) = TMP(J) Then 'condition : si la donnée ligne I colonne 3 de TV est égale à l'élément J de TMP
            K = K + 1 'incrémente K
            ReDim Preserve TL(1 To 9, 1 To K) 'redimensionne le tableau des lignes TL (7 lignes, K colonnes)
            TL(1, K) = TV(I, 1) 'récupère dans la ligne 1 de TL la donnée en colonne 1 de TV (=> transposition)
            TL(2, K) = TV(I, 2) 'récupère dans la ligne 2 de TL la donnée en colonne 2 de TV (=> transposition)
            TL(3, K) = TV(I, 3) 'récupère dans la ligne 3 de TL la donnée en colonne 3 de TV (=> transposition)
            TL(4, K) = TV(I, 8) 'récupère dans la ligne 4 de TL la donnée en colonne 8 de TV (=> transposition)
            TL(5, K) = TV(I, 12) 'récupère dans la ligne 5 de TL la donnée en colonne 12 de TV (=> transposition)
            TL(6, K) = TV(I, 19) 'récupère dans la ligne 6 de TL la donnée en colonne 19 de TV (=> transposition)
            TL(7, K) = TV(I, 27) 'récupère dans la ligne 7 de TL la donnée en colonne 27 de TV (=> transposition)
            If TL(6, K) = "" Or TL(7, K) = "" Then TL(8, K) = "" Else TL(8, K) = CDbl(TL(6, K) * TL(7, K)) 'calcule dans la ligne 8 de TL
            TL(9, K) = TV(I, 22) 'récupère dans la ligne 9 de TL la donnée en colonne 22 de TV (=> transposition)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle
    'si K est supérieure à zéro renvoie le tableau TL transposé dans la cellule A2 redimensionnée de l'onglet O
    If K > 0 Then O.Range("A2").Resize(K, 9).Value = Application.Transpose(TL)
    O.Columns(9).HorizontalAlignment = xlRight
Next J 'prochaine éléments de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Bonjour ThauTème,

Merci encore une fois ! Une dernière question sur ce fichier si ça te dérange pas, peut on avoir le résultat total de la la colonne "total" en dernière ligne (addition de toute les cellules) ? Avec le mot "Total:" qui se créer dans la cellule à la droite de ce résultat ?

Merci pour tout et merci d'avance !

Re,

Pas compris désolé. Propose nous un exemple.

Re,

Oui je t'ai fait une capture d'écran se sera peut être plus parlant ;)

Donc en rouge c'est ce que j'aimerais obtenir automatiquement (comme pour le reste que tu as déjà fait) dès l'ouverture du fichier. Donc pour chaque feuille le total que je t'ai mis en rouge et les totaux des sommes de chaque compte.

J'espère être plus clair et merci pour ta patience ThauThème !

capture d ecran 59

Re,

Est-ce que ce nouveau code convient ?

Private Sub Workbook_Open() 'a l'ouverture du fichier
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim PL() As Variant 'déclare la variable PL (Première Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim TMP1 As Variant 'déclare la variable TMP1 (tableau TeMPoraire 1)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim NT As Variant 'déclare la varaible NT (Nouveau tableau)
Dim T As Double 'déclare la variable T (Total)
Dim LI As Integer 'déclare la variable LI (LIgne)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set OS = Worksheets("INFO") 'définit l'onglet source OS
'définit la premiere ligne PL
PL = Array("Date de début", "Date de fin", "Projet", "Sous-Famille", "REF", "UTILISE", "Taux Act.", "Total", "Num. compte", "totaux")
Application.DisplayAlerts = False 'interdit les messages de l'application Excel
For I = Sheets.Count To 1 Step -1 'boucle inversée du dernier onglet au premier
    If Not Sheets(I).Name = "INFO" Then Sheets(I).Delete 'si l'onglet ne se nomme pas "INFO", supprime l'onget
Next I 'prochain onglet de la boucle
Application.DisplayAlerts = True 'autorise les messages de l'application Excel
TV = OS.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 3) <> "" Then D(TV(I, 3)) = "" 'alimente le dictionnaire D avec les éléments de la colonne 3 de TV (Projet)
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublons (les clés)
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments J de TMP
    Erase TL: K = 0 'vide le tableau TL, réinitialise la variable K
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Set O = Worksheets(TMP(J)) 'définit l'onglet O (onglet de l'élément J de TMP), génère une erreur si cet onglet n'existe pas
    If Err > 0 Then 'condition : si une erreur a été générée
        Err.Clear 'supprime l'erreur
        Worksheets.Add After:=Sheets(Sheets.Count) 'ajoute un onglet vierge en dernière position
        Set O = ActiveSheet 'définit l'onglet O
        O.Name = TMP(J) 'renomme l'onglet O avec le nom de l'élément J de TMP
    End If 'fon de la condition
    On Error GoTo 0 'annule la gestion des erreurs
    O.Range("A1").Resize(1, 10).Value = PL 'renvoie la première ligne PL dans A1 redimensionnée de l'onglet O
    For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 3) = TMP(J) Then 'condition : si la donnée ligne I colonne 3 de TV est égale à l'élément J de TMP
            K = K + 1 'incrémente K
            ReDim Preserve TL(1 To 9, 1 To K) 'redimensionne le tableau des lignes TL (7 lignes, K colonnes)
            TL(1, K) = TV(I, 1) 'récupère dans la ligne 1 de TL la donnée en colonne 1 de TV (=> transposition)
            TL(2, K) = TV(I, 2) 'récupère dans la ligne 2 de TL la donnée en colonne 2 de TV (=> transposition)
            TL(3, K) = TV(I, 3) 'récupère dans la ligne 3 de TL la donnée en colonne 3 de TV (=> transposition)
            TL(4, K) = TV(I, 8) 'récupère dans la ligne 4 de TL la donnée en colonne 8 de TV (=> transposition)
            TL(5, K) = TV(I, 12) 'récupère dans la ligne 5 de TL la donnée en colonne 12 de TV (=> transposition)
            TL(6, K) = TV(I, 19) 'récupère dans la ligne 6 de TL la donnée en colonne 19 de TV (=> transposition)
            TL(7, K) = TV(I, 27) 'récupère dans la ligne 7 de TL la donnée en colonne 27 de TV (=> transposition)
            If TL(6, K) = "" Or TL(7, K) = "" Then TL(8, K) = "" Else TL(8, K) = CDbl(TL(6, K) * TL(7, K)) 'calcule dans la ligne 8 de TL
            TL(9, K) = TV(I, 22) 'récupère dans la ligne 9 de TL la donnée en colonne 22 de TV (=> transposition)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    'si K est supérieure à zéro renvoie le tableau TL transposé dans la cellule A2 redimensionnée de l'onglet O
    If K > 0 Then O.Range("A2").Resize(K, 9).Value = Application.Transpose(TL)
    O.Columns(9).HorizontalAlignment = xlRight 'aligne la colonne 9 à droite
    O.Range("A1").CurrentRegion.Sort O.Range("I1"), xlAscending, Header:=xlYes 'tri lles valeur en fonction de du numéro de compte
    NT = O.Range("A1").CurrentRegion 'définit le nouveau tableau NT
    Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
    For I = 2 To UBound(NT, 1) 'boucle sur toutes les lignes I du tableau NT (en partant de la seconde)
        D(NT(I, 9)) = "" 'alimente le dictionnaire D avec les numéros de compte
    Next I 'prochaine ligne de la boucle
    TMP1 = D.Keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon (les clé)
    For K = 0 To UBound(TMP1) 'boucle 3 : sur tous les éléments K de TMP
        T = 0 'réinitialise le total T
        LI = 0 'réinitialise la ligne LI
        For I = 2 To UBound(NT, 1) 'boucle 4 : sur toutes les lignes I du nouveau tableau NT (en partant de la seconde)
            If NT(I, 9) = TMP1(K) Then 'condition si la donnée ligne I colonne 9 de NT est égale à l'élément K de TMP
                T = T + CDbl(NT(I, 8)) 'définit le total T (en ajoutant la valeur de la colonne 8 au total T)
                LI = IIf(LI = 0, I, LI) 'définit la ligne LI si différente de zéro
            End If 'fin de la condition
        Next I 'prochaine ligne de la boucle 4
        O.Cells(LI, 10).Value = T 'renvoie le total T dans la ligne LI colonne 10 de l'onglet O
    Next K 'prochain élément de la boucle 3
Next J 'prochaine élément de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Au Top Thauthème ! merci beaucoup !!!

Rechercher des sujets similaires à "extraire automatiquement donnees"