Discussion :

[audreyportiere]

Bonjour,

J’aurais besoin de vos lumières, j’ai un fichier excel avec plusieurs colonnes.
J’aimerais récupérer dans un nouveau fichier les informations des colonnes des 200 premières lignes par catégories (colonne AK et AJ),:
Ex : 200 lignes de CAROTTE de lille puis les 200 lignes CAROTTES PARIS, puis CAROTTES MARSEILLES
Ensuite les 200 premières lignes de POIREAU de lille puis les 200 lignes POIREAU PARIS, puis POIREAU MARSEILLE, si je n’ai pas de poireau à marseille, je n’aurais pas de ligne.

Vous trouverez ci-joint un exemple du fichier

J’espère que j’ai été assez claire, sinon n’hésitez pas à revenir vers moi.

Merci beaucoup pour votre aide

Bonne journée

Audrey

[Thautheme]

Bonjour Audrey, bonjour le forum,

Une proposition avec le code ci-dessous. Un nouveau classeur est créé et les 200 premières lignes de chaque catégorie sont placéee dans un onglet différent de ce nouveau classeur... Dis-nous si ça convient...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Dstination)
Dim TV As Variant 'déclare la variable TV (Tableau ds Valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (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)
 
Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Worksheets("Feuil1") 'définit l'onglet source OS
Set CD = Workbooks.Add 'définit le classeur destination CD (ouvre un classeur vierge)
TV = OS.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le ditionnaire D
For I = 2 To NL 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 36) & "-" & TV(I, 37)) = "" 'alimente le dictionnaire avec la donnée en colonne 36 (=>AJ), un tiret de séparation, et la donnée en colonne 37 (=>AK) de la ligne de la boucle
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des élément du dictionnaire D sans doublon
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire tmp
    K = 1: Erase TL 'initialise la variable K, vide le tableau TL
    For I = 2 To NL 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        'condition : si la donnée en colonne 36, un tiret de séparation et la donnée de la colonne 37 de la boucle 2 correspondent à l'élément de la boucle 1
        If TV(I, 36) & "-" & TV(I, 37) = TMP(J) Then
            ReDim Preserve TL(1 To NC, 1 To K) 'redimensionnee tableau des ligne TL (autant de lignes que TV a de colonnes, K colonnes)
            For L = 1 To NC 'bocule 3 : sur toutes les colonnes L du tableau des valeurs TV
                TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la donnée en colonne L de TV (=transposition)
            Next L 'prochaine colonne de la boucle 3
            K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
            If K = 201 Then GoTo suite 'si K est égale à 201, va à l'étiquette suite (pour ne prendre que les 200 premières lignes de chaque catégorie)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
suite: 'étiquette
    CD.Activate 'active le classeur destination CD
    CD.Worksheets.Add after:=CD.Worksheets(Sheets.Count) 'ajoute un onglet en dernière position
    Set OD = ActiveSheet 'définit l'onglet OD
    OD.Name = TMP(J) 'renomme l'onglet OD
    OD.Range("A1").Resize(1, NC) = Application.Index(TV, 1) 'renvoie la première ligne du tableau des valeurs TV dans A1 redimansionnée de l'onglet OS
    OD.Range("A2").Resize(K - 1, NC) = Application.Transpose(TL) 'renvoie le tableau des lignes transposé dans A2 redimensionnée de l'onglet OS
Next J 'prochain élément de la boucle 1
Application.DisplayAlerts = False 'masque les messages d'alerte d'excel (quand un onglet est supprimé par exemple)
For Each OS In CD.Sheets 'boucle sur tous les onglets OS du classeur destination CD
    If Left(OS.Name, 5) = "Feuil" Then OS.Delete 'si le nom de l'onglet commence par "Feuil", supprime l'onglet (à adapter selon la langue)
Next OS 'prochain onglet de la boucle
Application.DisplayAlerts = True 'affiche les messages d'alerte d'excel
End Sub

[audreyportiere]

Merci beaucoup Thautheme pour votre réactivité, c'est vraiment pas mal ce que vous avez fait , serait-il possible de compiler les différents onglets qui ont été créés en un seul, car j'ai besoin que les données n'apparaissent que sur une seule feuille.

En vous remerciant

Audrey

[Thautheme]

Re,

Le code adapté :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (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 DL As Long 'déclare la variable DL (Dernière Ligne)
 
Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Worksheets("Feuil1") 'définit l'onglet source OS
Set CD = Workbooks.Add 'définit le classeur destination CD (ouvre un classeur vierge)
TV = OS.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le ditionnaire D
For I = 2 To NL 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 36) & "-" & TV(I, 37)) = "" 'alimente le dictionnaire avec la donnée en colonne 36 (=>AJ), un tiret de séparation, et la donnée en colonne 37 (=>AK) de la ligne de la boucle
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des élément du dictionnaire D sans doublon
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire tmp
    K = 1: Erase TL 'initialise la variable K, vide le tableau TL
    For I = 2 To NL 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        'condition : si la donnée en colonne 36, un tiret de séparation et la donnée de la colonne 37 de la boucle 2 correspondent à l'élément de la boucle 1
        If TV(I, 36) & "-" & TV(I, 37) = TMP(J) Then
            ReDim Preserve TL(1 To NC, 1 To K) 'redimensionnee tableau des ligne TL (autant de lignes que TV a de colonnes, K colonnes)
            For L = 1 To NC 'bocule 3 : sur toutes les colonnes L du tableau des valeurs TV
                TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la donnée en colonne L de TV (=transposition)
            Next L 'prochaine colonne de la boucle 3
            K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
            If K = 201 Then GoTo suite 'si K est égale à 201, va à l'étiquette suite (pour ne prendre que les 200 premières lignes de chaque catégorie)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
suite: 'étiquette
    CD.Activate 'active le classeur destination CD
    Set OD = CD.Sheets(1) 'définit l'onglet OD (premier onglet du classeur destination)
    OD.Range("A1").Resize(1, NC) = Application.Index(TV, 1) 'renvoie la première ligne du tableau des valeurs TV dans A1 redimensionnée de l'onglet OS
    DL = OD.Cells(Application.Rows.Count, "A").End(xlUp).Row + 1 'définit la dernière ligne éditée DL de la colonne A de l'onglet OD
    OD.Cells(DL, "A").Resize(K - 1, NC) = Application.Transpose(TL) 'renvoie le tableau des lignes transposé dans la cellule ligbe DL colonne A redimensionnée de l'onglet OS
Next J 'prochain élément de la boucle 1
End Sub

[audreyportiere]

Oh là là, vous travaillez plus vite que la lumière, je vais tester la macro en grandeur nature et je reviendrais vers vous demain pour le verdict.

Merci beaucoup

[audreyportiere]

Mr Thautheme, c'est encore moi, j'ai testé la macro grandeur nature et j'ai un bug, vous trouverez le fichier dans le lien ci-dessous.
Est-ce parce que mon fichier fait plus de 200000 lignes ?

https://we.tl/t-8yVp4kmBfF

N'hésitez pas à revenir vers moi si vous avez des questions.

Merci beaucoup pour votre aide précieuse.

Audrey

[Thautheme]

Bonjour Audrey, bonjour le forum,

La macro modifiée et testée sur ton fichier. Ça semble fonctionner correctement.

le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (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 DL As Long 'déclare la variable DL (Dernière Ligne)
 
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Worksheets("Feuil1") 'définit l'onglet source OS
Set CD = Workbooks.Add 'définit le classeur destination CD (ouvre un classeur vierge)
TV = OS.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le ditionnaire D
For I = 2 To NL 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 36) & "-" & TV(I, 37)) = "" 'alimente le dictionnaire avec la donnée en colonne 36 (=>AJ), un tiret de séparation, et la donnée en colonne 37 (=>AK) de la ligne de la boucle
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des élément du dictionnaire D sans doublon
OS.Rows(1).Copy CD.Worksheets(1).Range("A1") 'copie la première ligne du tableau des valeurs dans la cellule A1 du premier onglet du classeur destination
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire tmp
    K = 1: Erase TL 'initialise la variable K, vide le tableau TL
    For I = 2 To NL 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        'condition : si la donnée en colonne 36, un tiret de séparation et la donnée de la colonne 37 de la boucle 2 correspondent à l'élément de la boucle 1
        If TV(I, 36) & "-" & TV(I, 37) = TMP(J) Then
            ReDim Preserve TL(1 To NC, 1 To K) 'redimensionnee tableau des ligne TL (autant de lignes que TV a de colonnes, K colonnes)
            For L = 1 To NC 'bocule 3 : sur toutes les colonnes L du tableau des valeurs TV
                TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la donnée en colonne L de TV (=transposition)
            Next L 'prochaine colonne de la boucle 3
            K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
            If K = 201 Then GoTo suite 'si K est égale à 201, va à l'étiquette suite (pour ne prendre que les 200 premières lignes de chaque catégorie)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
suite: 'étiquette
    CD.Activate 'active le classeur destination CD
    Set OD = CD.Sheets(1) 'définit l'onglet OD (premier onglet du classeur destination)
    DL = OD.Cells(Application.Rows.Count, "A").End(xlUp).Row + 1 'définit la dernière ligne éditée DL de la colonne A de l'onglet OD
    OD.Cells(DL, "A").Resize(K - 1, NC) = Application.Transpose(TL) 'renvoie le tableau des lignes transposé dans la cellule ligbe DL colonne A redimensionnée de l'onglet OS
Next J 'prochain élément de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "Transfert des données terminé !" 'message
End Sub

[audreyportiere]

Mais ça fonctionne plus que bien, c'est magnifyyyyyyyyyque.

Si j'osais, je vous demanderai encore une petite modification, mais je pense que c'est impossible à réaliser même au meilleur des développeurs, informaticiens, créateur...
Bon je tente quand même par ce que vous êtes très bon
Est-ce qu'il est possible que dans mon fichier il me sélectionne 1000 CHOCOLAT de CLERMONT et non 200 comme pour les autres, on ne touche pas aux autres ingrédients, 200 c'est parfait.
Si vous n'y arrivez pas, ce n'est pas grave, vous avez déjà fait beaucoup pour moi.

Merci

Audrey

[Thautheme]

Re,

C'est que pour les CHOCOLAT-CLERMONT ou pour TOUS les CHOCOLATS ?

Le code modifié pour les CHOCOLAT-CLERMONT :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (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 DL As Long 'déclare la variable DL (Dernière Ligne)
 
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Worksheets("Feuil1") 'définit l'onglet source OS
Set CD = Workbooks.Add 'définit le classeur destination CD (ouvre un classeur vierge)
TV = OS.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le ditionnaire D
For I = 2 To NL 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 36) & "-" & TV(I, 37)) = "" 'alimente le dictionnaire avec la donnée en colonne 36 (=>AJ), un tiret de séparation, et la donnée en colonne 37 (=>AK) de la ligne de la boucle
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des élément du dictionnaire D sans doublon
OS.Rows(1).Copy CD.Worksheets(1).Range("A1") 'copie la première ligne du tableau des valeurs dans la cellule A1 du premier onglet du classeur destination
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire tmp
    K = 1: Erase TL 'initialise la variable K, vide le tableau TL
    For I = 2 To NL 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        'condition : si la donnée en colonne 36, un tiret de séparation et la donnée de la colonne 37 de la boucle 2 correspondent à l'élément de la boucle 1
        If TV(I, 36) & "-" & TV(I, 37) = TMP(J) Then
            ReDim Preserve TL(1 To NC, 1 To K) 'redimensionnee tableau des ligne TL (autant de lignes que TV a de colonnes, K colonnes)
            For L = 1 To NC 'bocule 3 : sur toutes les colonnes L du tableau des valeurs TV
                TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la donnée en colonne L de TV (=transposition)
            Next L 'prochaine colonne de la boucle 3
            K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
            If TMP(J) = "CHOCOLAT-CLERMONT" And K = 101 Then GoTo suite 'va à l'étiquette suite si K=101 pour le "CHOCOLAT-CLERMONT" ****************************************** <= ICI
            If K = 201 Then GoTo suite 'si K est égale à 201, va à l'étiquette suite (pour ne prendre que les 200 premières lignes de chaque catégorie)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
suite: 'étiquette
    CD.Activate 'active le classeur destination CD
    Set OD = CD.Sheets(1) 'définit l'onglet OD (premier onglet du classeur destination)
    DL = OD.Cells(Application.Rows.Count, "A").End(xlUp).Row + 1 'définit la dernière ligne éditée DL de la colonne A de l'onglet OD
    OD.Cells(DL, "A").Resize(K - 1, NC) = Application.Transpose(TL) 'renvoie le tableau des lignes transposé dans la cellule ligbe DL colonne A redimensionnée de l'onglet OS
Next J 'prochain élément de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "Transfert des données terminé !" 'message
End Sub

[audreyportiere]

C'est que pour les chocolats de CLERMONT.

Merci

Audrey

[Thautheme]

Re,

Code modifié sur post au-dessus #9...

[Thautheme]

Re,

Bon je tente quand même par ce que vous êtes très bon

Arf ! Vous allez faire se rouler par-terre tous les contributeurs de se forum...

[audreyportiere]

Je n'avais pas vu que vous aviez déjà répondu, vous êtes trop rapide pour moi.
c'est presque parfait, il y a une toute petite modification à apporter, j'ai besoin de 1000 chocolat de clermont et non 100 chocolat et oui je suis gourmande .

Et je suis sincère, je trouve vraiment que vous êtes bon. Et si les autres se roulent par terre, c'est qu'ils sont certainement jaloux de votre talent.

Encore merci.

Audrey

[Thautheme]

Re,

Désolé j'avais mal lu... Le code adapté :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (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 DL As Long 'déclare la variable DL (Dernière Ligne)
 
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Worksheets("Feuil1") 'définit l'onglet source OS
Set CD = Workbooks.Add 'définit le classeur destination CD (ouvre un classeur vierge)
TV = OS.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le ditionnaire D
For I = 2 To NL 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 36) & "-" & TV(I, 37)) = "" 'alimente le dictionnaire avec la donnée en colonne 36 (=>AJ), un tiret de séparation, et la donnée en colonne 37 (=>AK) de la ligne de la boucle
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des élément du dictionnaire D sans doublon
OS.Rows(1).Copy CD.Worksheets(1).Range("A1") 'copie la première ligne du tableau des valeurs dans la cellule A1 du premier onglet du classeur destination
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire tmp
    K = 1: Erase TL 'initialise la variable K, vide le tableau TL
    For I = 2 To NL 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        'condition : si la donnée en colonne 36, un tiret de séparation et la donnée de la colonne 37 de la boucle 2 correspondent à l'élément de la boucle 1
        If TV(I, 36) & "-" & TV(I, 37) = TMP(J) Then
            ReDim Preserve TL(1 To NC, 1 To K) 'redimensionnee tableau des ligne TL (autant de lignes que TV a de colonnes, K colonnes)
            For L = 1 To NC 'bocule 3 : sur toutes les colonnes L du tableau des valeurs TV
                TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la donnée en colonne L de TV (=transposition)
            Next L 'prochaine colonne de la boucle 3
            K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
            If TMP(J) = "CHOCOLAT-CLERMONT" Then 'condition : si CHOCOLAT-CLERMONT
                If K = 1001 Then GoTo suite 'va à l'étiquette suite si K=1001
            Else 'sinon
                If K = 201 Then GoTo suite 'si K est égale à 201, va à l'étiquette suite (pour ne prendre que les 200 premières lignes de chaque catégorie)
            End If 'fin de la condition
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
suite: 'étiquette
    CD.Activate 'active le classeur destination CD
    Set OD = CD.Sheets(1) 'définit l'onglet OD (premier onglet du classeur destination)
    DL = OD.Cells(Application.Rows.Count, "A").End(xlUp).Row + 1 'définit la dernière ligne éditée DL de la colonne A de l'onglet OD
    OD.Cells(DL, "A").Resize(K - 1, NC) = Application.Transpose(TL) 'renvoie le tableau des lignes transposé dans la cellule ligbe DL colonne A redimensionnée de l'onglet OS
Next J 'prochain élément de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "Transfert des données terminé !" 'message
End Sub

[audreyportiere]

Bonjour Mr Thauthème,

Je n'ai qu'un seul mot à vous dire : MERCI.
Et puis non j'ai un autre mot à vous dire : Je vous aime.

Votre macro est parfaite, plus que parfaite, je vais gagner un temps fou, j'ai presqu'envie de vous offrir des chocolats .


Merci à vous, merci d'être là, merci d'aider les pauvres âmes comme moi nulle en macro, merci de m'avoir aider, de me redonner foi en l'homme, merci cher inconnu qui me donnait le sourire quand il me répondait, merci au forum, merci à la vie et à très bientôt, peut être.

Je me répête, merci mon héros, mon sauveur et je garde précieusement votre nom au coin de ma tête

Bon je vais arrêter, je me saoûle moi même.

Bises,
Audrey

[Thautheme]

Re,

Mort de rire... Je n'avais jamais eu de tels remerciements...

[audreyportiere]

Mais c'est normal, vous le méritez Au revoir Mr Thauthème...

[audreyportiere]

Bonjour,

Je reviens sur le forum car Mr Thauthème, vous m'avez beaucoup aidé et je vous en remercie encore.
Mon fichier a été quelque peu modifié (petit recap, fichier carottes navet ou il faut récupérer les 200 premières lignes...) j'ai aujourd'hui des dates et lorsque je lance la macro j'ai certaines dates en anglais et je n'arrive pas à comprendre pourquoi certaines sont en français et d'autres en anglais.
vous trouverez ci-après le fichier via wetransfer.

https://we.tl/t-Fpp21ntPOn

Si vous avez un peu de temps pour aider une pauvre damoiselle en détresse, je vous en serai reconnaissante à vie.

Merci

audrey