Discussion :

[lourid]

Bonjour a tous
dans un fichier 1.xlsm j'ai un tableau avec 24 colonnes et un nombre de lignes qui peut varier.
je voudrais créer un fichier avec les colonnes A-B-X-C-D-E-K-M uniquement sur la base des données de la colonne G (file Riepilogo)


je joins le fichier

[Franc]

Bonjour, personnellement je ne comprends pas ta demande, tu peux être plus précis ?

[lourid]

Bonjour, personnellement je ne comprends pas ta demande, tu peux être plus précis ?

Bonsoir e merci

Je voudrais diviser le fichier en fonction de la description unique de la colonne G avec seulement quelques colonnes

Azienda Matricola SAP_NUMBER Centro_Costo Anno Mese Ore_GG Valore Contr_INPS

[lourid]

dans la première feuille du fichier "riepilogo"
il y a le total du fichier "totale" des colonnes K M R de la colonne G
"FRUITO STIMATO ROL EMP" et ainsi de suite dans les autres feuilles

J'espère que je me suis expliqué, je rattache les bons fichiers

[Franc]

Bonjour, je pense avoir compris tes besoins.
A partir de ton fichier "totale" tu veux répartir les lignes dans ton fichier "riepilogo" dans les différentes feuilles qui ont le même nom que les catégories de ta colonne G de "totale". Voici une macro pour le faire. Insère un module dans ton classeur "totale" et copie la macro.
Par défaut, je considère que tes 2 classeurs sont ouverts.
S'il y a déjà des données dans les feuilles de 'riepilogo", elles seront copiées en-dessous.
S'il n'y a rien, la copie se fera à partir de la ligne 2 de chaque feuille.
Je ne copie que les cellules que tu as définies dans ton précédent message.

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
57
58
59
60
61
62
63
64
65
66
67
Sub CopierDonneesVersFeuillesCibles()
    Dim classeurSource As Workbook
    Dim classeurCible As Workbook
    Dim feuilleSource As Worksheet
    Dim feuilleCible As Worksheet
    Dim dernierLigneSource As Long
    Dim categories As Range
    Dim categorie As Range
    Dim categorieNom As String
    Dim ligneSource As Range
    Dim tableauDonnees() As Variant
    Dim i As Long
    Dim dernierLigneCible As Long
 
    ' Référencer les classeurs et les feuilles
    Set classeurSource = Workbooks("totale.xlsx") ' Remplacez par le nom de votre classeur source
    Set classeurCible = Workbooks("riepilogo.xlsx") ' Remplacez par le nom de votre classeur cible
    Set feuilleSource = classeurSource.Sheets(1) ' Utilisez le numéro de la feuille ou son nom si différent
 
    ' Récupérer les catégories uniques de la colonne G
    dernierLigneSource = feuilleSource.Cells(Rows.Count, "G").End(xlUp).Row
    Set categories = feuilleSource.Range("G2:G" & dernierLigneSource)
    categories.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("Z1"), Unique:=True
 
    ' Parcourir les catégories et copier les données correspondantes dans les feuilles cibles
    For Each categorie In Range("Z2:Z" & Range("Z" & Rows.Count).End(xlUp).Row)
        categorieNom = categorie.Value
 
        Set feuilleCible = classeurCible.Sheets(categorieNom)
 
        If Not feuilleCible Is Nothing Then ' Vérifier si la feuille cible existe
            ' Trouver la dernière ligne non vide dans la feuille cible
            dernierLigneCible = feuilleCible.Cells(Rows.Count, 1).End(xlUp).Row
 
            ' Copier les données de la colonne G dans le tableau en mémoire
            Set ligneSource = feuilleSource.Range("G2:G" & dernierLigneSource).SpecialCells(xlCellTypeConstants, xlTextValues).EntireRow
            tableauDonnees = ligneSource.Value
 
            ' Parcourir les données du tableau en mémoire et copier les valeurs correspondantes dans la feuille cible
            For i = 1 To UBound(tableauDonnees, 1)
                With feuilleCible
                    ' Trouver la prochaine ligne disponible dans la feuille cible
                    dernierLigneCible = dernierLigneCible + 1
 
                    ' Copier les valeurs dans les colonnes spécifiées
                    .Cells(dernierLigneCible, 1).Value = tableauDonnees(i, 1) ' Colonne A
                    .Cells(dernierLigneCible, 2).Value = tableauDonnees(i, 2) ' Colonne B
                    .Cells(dernierLigneCible, 3).Value = tableauDonnees(i, 24) ' Colonne X
                    .Cells(dernierLigneCible, 4).Value = tableauDonnees(i, 3) ' Colonne C
                    .Cells(dernierLigneCible, 5).Value = tableauDonnees(i, 4) ' Colonne D
                    .Cells(dernierLigneCible, 6).Value = tableauDonnees(i, 5) ' Colonne E
                    .Cells(dernierLigneCible, 7).Value = tableauDonnees(i, 11) ' Colonne K
                    .Cells(dernierLigneCible, 8).Value = tableauDonnees(i, 13) ' Colonne M
                    .Cells(dernierLigneCible, 9).Value = tableauDonnees(i, 18) ' Colonne R
                End With
            Next i
        Else
            MsgBox "La feuille cible '" & categorieNom & "' n'existe pas dans le classeur cible.", vbExclamation
         End If
    Next categorie
 
    ' Supprimer la colonne temporaire utilisée pour filtrer les catégories uniques
    classeurSource.Sheets(1).Range("Z:Z").Delete
 
    MsgBox "Les données ont été copiées avec succès vers les feuilles cibles.", vbInformation
 
End Sub

[lourid]

Merci beaucoup pour votre intérêt
Je dirais que nous le sommes.
j'ai vu ça dans le fichier riepiologo cela ne me ramène pas les en-têtes de colonne dans les différentes feuilles car je suppose qu'ils doivent déjà être là.

Je vous demande s'il m'est possible de créer le fichier riepilogo

[Franc]

Vous voulez dire qu'il faut le créer comme s'il n'existait pas ? Et donc aussi créer les feuilles et les entêtes ? Et ensuite copier les données du fichier "totale" ?

[deedolith]

Salut,

S'il s'agit juste de filtrer et copier les données dans une feuille particulière, met VBA à la poubelle (trop d'efforts à fournir + risques d'erreur) et passe par Power Query qui fera le job beaucoup plus facilement:

Code :

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

1
2
3
4
5
6
7
8
9
10
let
    Source = Excel.Workbook(File.Contents("C:\........\totale.xlsx"), null, true),
    #"4414_Stimato-ControlloCalcolo_0_Sheet" = Source{[Item="4414_Stimato-ControlloCalcolo_0",Kind="Sheet"]}[Data],
    #"En-têtes promus" = Table.PromoteHeaders(#"4414_Stimato-ControlloCalcolo_0_Sheet", [PromoteAllScalars=true]),
    #"Type modifié" = Table.TransformColumnTypes(#"En-têtes promus",{{"Azienda", Int64.Type}, {"Matricola", Int64.Type}, {"Centro_Costo", Int64.Type}, {"Anno", Int64.Type}, {"Mese", Int64.Type}, {"Cod_Ril", type text}, {"Descrizione", type text}, {"RETRIBUZIONE", type number}, {"P.T.", type number}, {"VE", type text}, {"Ore_GG", type number}, {"Base", type number}, {"Valore", type number}, {"Valorizzazione", type number}, {"Aliq_INPS", type number}, {"controllo", type text}, {"Aliq_INAIL", type number}, {"Contr_INPS", type number}, {"Valorizzazione_1", type number}, {"Contr_Inail", type number}, {"Conto", Int64.Type}, {"Cod_Rateo", Int64.Type}, {"Tipo_Rateo", type text}, {"SAP_NUMBER", Int64.Type}}),
    #"Lignes filtrées" = Table.SelectRows(#"Type modifié", each ([Descrizione] = "ACC.TO STIMATO OVT EMP")),
    #"Colonnes permutées" = Table.ReorderColumns(#"Lignes filtrées",{"Azienda", "Matricola", "SAP_NUMBER", "Centro_Costo", "Anno", "Mese", "Ore_GG", "Valore", "Contr_INPS", "Cod_Ril", "Descrizione", "RETRIBUZIONE", "P.T.", "VE", "Base", "Valorizzazione", "Aliq_INPS", "controllo", "Aliq_INAIL", "Valorizzazione_1", "Contr_Inail", "Conto", "Cod_Rateo", "Tipo_Rateo"}),
    #"Colonnes supprimées" = Table.RemoveColumns(#"Colonnes permutées",{"Cod_Ril", "Descrizione", "RETRIBUZIONE", "P.T.", "VE", "Base", "Valorizzazione", "Aliq_INPS", "controllo", "Aliq_INAIL", "Valorizzazione_1", "Contr_Inail", "Conto", "Cod_Rateo", "Tipo_Rateo"})
in
    #"Colonnes supprimées"

Quand au nom des feuilles, vu que c'est du "one shot", fait le à la main.

[lourid]

Merci pour la réponse, je me suis mal exprimé.
Je voulais dire que vous pouvez commencer la macro à partir de la feuille "RIEPIOLOGO" si possible et renommer les feuilles comme ceci
feuille 1 FRUITO STIMATO ROL EMP Fruito ROL
feuille 2 FRUITO STIMATO BO EMP Fruito BO
feuille 3 FRUITO STIMATO OVT EMP OVT
feuille 4 FRUITO STIMATO VAC EMP Fruito VAC

[Franc]

Encore une fois, je ne comprends pas ce que vous voulez. La macro est bien commentée et facile à suivre, si vous devez changer des noms ce n'est pas compliqué à faire à la main. Du moment que les noms des feuilles correspondent aux noms de la colonne G du fichier "Totale" la macro fonctionne.

[lourid]

ok merci, mais est-il possible de lancer la macro depuis le fichier "riepilogo" ?

[Franc]

oui, il suffit d'insérer un nouveau module dans le classeur "riepilogo" et de déplacer la macro d'un classeur vers l'autre.

[lourid]

merci

[lourid]

Bonsoir,
je n'ai pas compris, les données qu'il me ramène dans le fichier "riepilogo" sont les mêmes pour toutes les feuilles

par exemple dans la première feuille file "riepilogo" je m'attendais :
colonne G totalise 325,3
colonne H totalise 40443,12
colonne I totalise 11573,85
selon le fichier "Totale" colonne G en filtrant les données "FRUITO STIMATO VAC EMP"

[Franc]

Comme ceci:

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
57
58
59
60
61
62
63
64
65
66
67
Sub CopierDonneesVersFeuillesCibles()
    Dim classeurSource As Workbook
    Dim classeurCible As Workbook
    Dim feuilleSource As Worksheet
    Dim dernierLigneSource As Long
    Dim categories As Range
    Dim categorie As Range
    Dim categorieNom As String
    Dim ligneSource As Range
    Dim tableauDonnees() As Variant
    Dim i As Long
    Dim feuilleCible As Worksheet
    Dim dernierLigneCible As Long
 
    ' Référencer les classeurs et les feuilles
    Set classeurSource = Workbooks("totale.xlsx") ' Remplacez par le nom de votre classeur source
    Set classeurCible = Workbooks("riepilogo.xlsm") ' Remplacez par le nom de votre classeur cible
    Set feuilleSource = classeurSource.Sheets(1) ' Utilisez le numéro de la feuille ou son nom si différent
 
    ' Récupérer les catégories uniques de la colonne G
    dernierLigneSource = feuilleSource.Cells(Rows.Count, "G").End(xlUp).Row
    Set categories = feuilleSource.Range("G2:G" & dernierLigneSource)
    categories.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("Z1"), Unique:=True
 
    ' Parcourir les catégories et copier les données correspondantes dans les feuilles cibles
    For Each categorie In Range("Z2:Z" & Range("Z" & Rows.Count).End(xlUp).Row)
        categorieNom = categorie.Value
        Set feuilleCible = classeurCible.Sheets(categorieNom)
 
        If Not feuilleCible Is Nothing Then ' Vérifier si la feuille cible existe
            ' Trouver la dernière ligne non vide dans la feuille cible
            dernierLigneCible = feuilleCible.Cells(Rows.Count, 1).End(xlUp).Row
 
            ' Copier les données correspondant à la catégorie dans le tableau en mémoire
            Set ligneSource = feuilleSource.Range("A2:X" & dernierLigneSource).SpecialCells(xlCellTypeVisible).Rows
            tableauDonnees = ligneSource.Value
 
            ' Parcourir les données du tableau en mémoire et copier les valeurs correspondantes dans la feuille cible
            For i = 1 To UBound(tableauDonnees, 1)
                If tableauDonnees(i, 7) = categorieNom Then ' Vérifier si la catégorie correspond
 
                    ' Trouver la prochaine ligne disponible dans la feuille cible
                    dernierLigneCible = dernierLigneCible + 1
 
                    ' Copier les valeurs dans les colonnes spécifiées
                    With feuilleCible
                        .Cells(dernierLigneCible, 1).Value = tableauDonnees(i, 1) ' Colonne A
                        .Cells(dernierLigneCible, 2).Value = tableauDonnees(i, 2) ' Colonne B
                        .Cells(dernierLigneCible, 3).Value = tableauDonnees(i, 24) ' Colonne X
                        .Cells(dernierLigneCible, 4).Value = tableauDonnees(i, 3) ' Colonne C
                        .Cells(dernierLigneCible, 5).Value = tableauDonnees(i, 4) ' Colonne D
                        .Cells(dernierLigneCible, 6).Value = tableauDonnees(i, 5) ' Colonne E
                        .Cells(dernierLigneCible, 7).Value = tableauDonnees(i, 11) ' Colonne K
                        .Cells(dernierLigneCible, 8).Value = tableauDonnees(i, 13) ' Colonne M
                        .Cells(dernierLigneCible, 9).Value = tableauDonnees(i, 18) ' Colonne R
                    End With
                End If
            Next i
        End If
    Next categorie
 
    ' Supprimer la colonne temporaire utilisée pour filtrer les catégories uniques
    classeurSource.Sheets(1).Columns("Z").Delete
 
    MsgBox "Les données ont été copiées avec succès vers les feuilles cibles.", vbInformation
 
End Sub

[lourid]

exactement, parfait

Comme ceci:

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
57
58
59
60
61
62
63
64
65
66
67
Sub CopierDonneesVersFeuillesCibles()
    Dim classeurSource As Workbook
    Dim classeurCible As Workbook
    Dim feuilleSource As Worksheet
    Dim dernierLigneSource As Long
    Dim categories As Range
    Dim categorie As Range
    Dim categorieNom As String
    Dim ligneSource As Range
    Dim tableauDonnees() As Variant
    Dim i As Long
    Dim feuilleCible As Worksheet
    Dim dernierLigneCible As Long
 
    ' Référencer les classeurs et les feuilles
    Set classeurSource = Workbooks("totale.xlsx") ' Remplacez par le nom de votre classeur source
    Set classeurCible = Workbooks("riepilogo.xlsm") ' Remplacez par le nom de votre classeur cible
    Set feuilleSource = classeurSource.Sheets(1) ' Utilisez le numéro de la feuille ou son nom si différent
 
    ' Récupérer les catégories uniques de la colonne G
    dernierLigneSource = feuilleSource.Cells(Rows.Count, "G").End(xlUp).Row
    Set categories = feuilleSource.Range("G2:G" & dernierLigneSource)
    categories.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("Z1"), Unique:=True
 
    ' Parcourir les catégories et copier les données correspondantes dans les feuilles cibles
    For Each categorie In Range("Z2:Z" & Range("Z" & Rows.Count).End(xlUp).Row)
        categorieNom = categorie.Value
        Set feuilleCible = classeurCible.Sheets(categorieNom)
 
        If Not feuilleCible Is Nothing Then ' Vérifier si la feuille cible existe
            ' Trouver la dernière ligne non vide dans la feuille cible
            dernierLigneCible = feuilleCible.Cells(Rows.Count, 1).End(xlUp).Row
 
            ' Copier les données correspondant à la catégorie dans le tableau en mémoire
            Set ligneSource = feuilleSource.Range("A2:X" & dernierLigneSource).SpecialCells(xlCellTypeVisible).Rows
            tableauDonnees = ligneSource.Value
 
            ' Parcourir les données du tableau en mémoire et copier les valeurs correspondantes dans la feuille cible
            For i = 1 To UBound(tableauDonnees, 1)
                If tableauDonnees(i, 7) = categorieNom Then ' Vérifier si la catégorie correspond
 
                    ' Trouver la prochaine ligne disponible dans la feuille cible
                    dernierLigneCible = dernierLigneCible + 1
 
                    ' Copier les valeurs dans les colonnes spécifiées
                    With feuilleCible
                        .Cells(dernierLigneCible, 1).Value = tableauDonnees(i, 1) ' Colonne A
                        .Cells(dernierLigneCible, 2).Value = tableauDonnees(i, 2) ' Colonne B
                        .Cells(dernierLigneCible, 3).Value = tableauDonnees(i, 24) ' Colonne X
                        .Cells(dernierLigneCible, 4).Value = tableauDonnees(i, 3) ' Colonne C
                        .Cells(dernierLigneCible, 5).Value = tableauDonnees(i, 4) ' Colonne D
                        .Cells(dernierLigneCible, 6).Value = tableauDonnees(i, 5) ' Colonne E
                        .Cells(dernierLigneCible, 7).Value = tableauDonnees(i, 11) ' Colonne K
                        .Cells(dernierLigneCible, 8).Value = tableauDonnees(i, 13) ' Colonne M
                        .Cells(dernierLigneCible, 9).Value = tableauDonnees(i, 18) ' Colonne R
                    End With
                End If
            Next i
        End If
    Next categorie
 
    ' Supprimer la colonne temporaire utilisée pour filtrer les catégories uniques
    classeurSource.Sheets(1).Columns("Z").Delete
 
    MsgBox "Les données ont été copiées avec succès vers les feuilles cibles.", vbInformation
 
End Sub