Microsoft 365 Scinder des données en plusieurs fichiers Excel avec nom généré automatiquement

J

jckbrtn

XLDnaute Nouveau
Bonjour à tous,

Je cherche à scinder des données Excel dans différents fichiers Excel avec comme un nom de fichier généré via les infos de 2 colonnes.

Un exemple en annexe : les données brutes et dans les feuilles de calcul, les données qui devraient être scindées dans des fichiers différents avec le nom de fichier désiré colonne A et B = 161 AAAA par exemple

Merci d’avance pour votre aide !
 

Pièces jointes

  • Exemple annexe excel.xlsx
    22.5 KB · Affichages: 6
Trier par date Trier par votes
J

JHA

XLDnaute Barbatruc
Bonjour à tous,

Tu peux créer les tableaux sous Power Query et tu actualises les tableaux après ajout ou suppression des données de la feuille "Sheet1".
Pas de formule et pas de VBA.

JHA
 

Pièces jointes

  • Exemple annexe excel.xlsx
    45.5 KB · Affichages: 12
Vote positif 0 Vote négatif
Jacky67

Jacky67

XLDnaute Barbatruc
jckbrtn à dit:
Bonjour à tous,

Je cherche à scinder des données Excel dans différents fichiers Excel avec comme un nom de fichier généré via les infos de 2 colonnes.

Un exemple en annexe : les données brutes et dans les feuilles de calcul, les données qui devraient être scindées dans des fichiers différents avec le nom de fichier désiré colonne A et B = 161 AAAA par exemple

Merci d’avance pour votre aide !
Cliquez pour agrandir...
Bonjour à tous
Une proposition toutes versions xl en PJ par vba avec ce code
VB: 
Sub Creation()
    Dim Plage, C As Range
    Application.ScreenUpdating = False
    With Feuil1
        Set Plage = .[a1].CurrentRegion
        On Error Resume Next    ' si rien à filtrer
        Plage.Resize(, Plage.Columns.Count - 4).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("I1:J1"), Unique:=True
        For Each C In .Range("i2:i" & Application.Count(.Columns(9)))
            If Not Evaluate("ISREF('" & C & " " & C.Offset(, 1) & "'!A1)") Then Sheets.Add.Name = C & " " & C.Offset(, 1)
            With Sheets(C & " " & C.Offset(, 1))
                .Columns("a:f").Clear
                Plage.AutoFilter Field:=1, Criteria1:=C
                Plage.SpecialCells(xlCellTypeVisible).Copy .[a1]
            End With
        Next
        Plage.AutoFilter: .Columns("i:j").Clear: .[a1].Activate
    End With
End Sub
Oupps, s'il faut créer des classeurs et non des feuilles, une version V2
Les classeurs sont créés dans le répertoire du classeur maitre
 

Pièces jointes

  • Exemple annexe excel.xlsm
    28 KB · Affichages: 2
  • Exemple annexe excel V2.xlsm
    28.8 KB · Affichages: 8
Dernière édition:
Vote positif 0 Vote négatif
J

jckbrtn

XLDnaute Nouveau
Jacky67 à dit:
Bonjour à tous
Une proposition toutes versions xl en PJ par vba avec ce code
VB: 
Sub Creation()
    Dim Plage, C As Range
    Application.ScreenUpdating = False
    With Feuil1
        Set Plage = .[a1].CurrentRegion
        On Error Resume Next    ' si rien à filtrer
        Plage.Resize(, Plage.Columns.Count - 4).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("I1:J1"), Unique:=True
        For Each C In .Range("i2:i" & Application.Count(.Columns(9)))
            If Not Evaluate("ISREF('" & C & " " & C.Offset(, 1) & "'!A1)") Then Sheets.Add.Name = C & " " & C.Offset(, 1)
            With Sheets(C & " " & C.Offset(, 1))
                .Columns("a:f").Clear
                Plage.AutoFilter Field:=1, Criteria1:=C
                Plage.SpecialCells(xlCellTypeVisible).Copy .[a1]
            End With
        Next
        Plage.AutoFilter: .Columns("i:j").Clear: .[a1].Activate
    End With
End Sub
Oupps, s'il faut créer des classeurs et non des feuilles, une version V2
Les classeurs sont créés dans le répertoire du classeur maitre
Cliquez pour agrandir...
Salut Jacky,

J'essaie ça dès que possible!

Bonne soirée,

Jckbrtn
 
Vote positif 0 Vote négatif
J

jckbrtn

XLDnaute Nouveau
Jacky67 à dit:
Bonjour à tous
Une proposition toutes versions xl en PJ par vba avec ce code
VB: 
Sub Creation()
    Dim Plage, C As Range
    Application.ScreenUpdating = False
    With Feuil1
        Set Plage = .[a1].CurrentRegion
        On Error Resume Next    ' si rien à filtrer
        Plage.Resize(, Plage.Columns.Count - 4).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("I1:J1"), Unique:=True
        For Each C In .Range("i2:i" & Application.Count(.Columns(9)))
            If Not Evaluate("ISREF('" & C & " " & C.Offset(, 1) & "'!A1)") Then Sheets.Add.Name = C & " " & C.Offset(, 1)
            With Sheets(C & " " & C.Offset(, 1))
                .Columns("a:f").Clear
                Plage.AutoFilter Field:=1, Criteria1:=C
                Plage.SpecialCells(xlCellTypeVisible).Copy .[a1]
            End With
        Next
        Plage.AutoFilter: .Columns("i:j").Clear: .[a1].Activate
    End With
End Sub
Oupps, s'il faut créer des classeurs et non des feuilles, une version V2
Les classeurs sont créés dans le répertoire du classeur maitre
Cliquez pour agrandir...
Top, c'est hyper facile et même si le power query m'intéresse, je vais utiliser ta macro car pas le temps de me pencher sur autre chose pour le moment!
 
Vote positif 0 Vote négatif
J

jckbrtn

XLDnaute Nouveau
Jacky67 à dit:
Bonjour à tous
Une proposition toutes versions xl en PJ par vba avec ce code
VB: 
Sub Creation()
    Dim Plage, C As Range
    Application.ScreenUpdating = False
    With Feuil1
        Set Plage = .[a1].CurrentRegion
        On Error Resume Next    ' si rien à filtrer
        Plage.Resize(, Plage.Columns.Count - 4).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("I1:J1"), Unique:=True
        For Each C In .Range("i2:i" & Application.Count(.Columns(9)))
            If Not Evaluate("ISREF('" & C & " " & C.Offset(, 1) & "'!A1)") Then Sheets.Add.Name = C & " " & C.Offset(, 1)
            With Sheets(C & " " & C.Offset(, 1))
                .Columns("a:f").Clear
                Plage.AutoFilter Field:=1, Criteria1:=C
                Plage.SpecialCells(xlCellTypeVisible).Copy .[a1]
            End With
        Next
        Plage.AutoFilter: .Columns("i:j").Clear: .[a1].Activate
    End With
End Sub
Oupps, s'il faut créer des classeurs et non des feuilles, une version V2
Les classeurs sont créés dans le répertoire du classeur maitre
Cliquez pour agrandir...
Bonsoir Jacky,

J'avais testé et réussi à modifier ta macro car j'avais ajouter une colonne à mon tableau initial (en annexe).
J'avais noté d'adapter les lignes suivantes à ta macro mais je n'y arrive plus...
VB: 
Plage.Resize(, Plage.Columns.Count - 4).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("I1:J1"), Unique:=True
.Columns("a:f").Clear

Est-ce que tu pourrais m'aider, stp? ;)

Merci d'avance et bon week end,

Jckbrtn
 

Pièces jointes

  • Exemple annexe excel.xlsm
    29.7 KB · Affichages: 6
Vote positif 0 Vote négatif
Jacky67

Jacky67

XLDnaute Barbatruc
jckbrtn à dit:
Bonsoir Jacky,

J'avais testé et réussi à modifier ta macro car j'avais ajouter une colonne à mon tableau initial (en annexe).
J'avais noté d'adapter les lignes suivantes à ta macro mais je n'y arrive plus...
VB: 
Plage.Resize(, Plage.Columns.Count - 4).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("I1:J1"), Unique:=True
.Columns("a:f").Clear

Est-ce que tu pourrais m'aider, stp? ;)

Merci d'avance et bon week end,

Jckbrtn
Cliquez pour agrandir...
Re..
On reste donc à la création de feuilles.
Les données numérique de la colonne A sont devenues des données texte
Donc ....Application.Count(.Columns(9))) devient Application.CountA(.Columns(9)))
VB: 
Sub Creation()
    Dim Plage, C As Range
    Application.ScreenUpdating = False
    With Feuil1
        Set Plage = .[a1].CurrentRegion
        On Error Resume Next    ' si rien à filtrer
        Plage.Resize(, Plage.Columns.Count - 5).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("I1:J1"), Unique:=True
        For Each C In .Range("i2:i" & Application.CountA(.Columns(9)))
            If Not Evaluate("ISREF('" & C & " " & C.Offset(, 1) & "'!A1)") Then Sheets.Add.Name = C & " " & C.Offset(, 1)
            With Sheets(C & " " & C.Offset(, 1))
                .Columns("a:g").Clear
                Plage.AutoFilter Field:=1, Criteria1:=C
                Plage.SpecialCells(xlCellTypeVisible).Copy .[a1]
            End With
        Next
        Plage.AutoFilter: .Columns("i:j").Clear: .Activate
    End With
End Sub
 

Pièces jointes

  • Exemple annexe excel.xlsm
    29.4 KB · Affichages: 8
Dernière édition:
Vote positif 0 Vote négatif
J

jckbrtn

XLDnaute Nouveau
Jacky67 à dit:
Re..
On reste donc à la création de feuilles.
Les données numérique de la colonne A sont devenues des données texte
Donc ....Application.Count(.Columns(9))) devient Application.CountA(.Columns(9)))
VB: 
Sub Creation()
    Dim Plage, C As Range
    Application.ScreenUpdating = False
    With Feuil1
        Set Plage = .[a1].CurrentRegion
        On Error Resume Next    ' si rien à filtrer
        Plage.Resize(, Plage.Columns.Count - 5).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("I1:J1"), Unique:=True
        For Each C In .Range("i2:i" & Application.CountA(.Columns(9)))
            If Not Evaluate("ISREF('" & C & " " & C.Offset(, 1) & "'!A1)") Then Sheets.Add.Name = C & " " & C.Offset(, 1)
            With Sheets(C & " " & C.Offset(, 1))
                .Columns("a:g").Clear
                Plage.AutoFilter Field:=1, Criteria1:=C
                Plage.SpecialCells(xlCellTypeVisible).Copy .[a1]
            End With
        Next
        Plage.AutoFilter: .Columns("i:j").Clear: .Activate
    End With
End Sub
Cliquez pour agrandir...
Salut Jacky,

Merci de t'être penché rapidement sur mon problème.
Ca fonctionne sauf que ça créée des feuilles séparés et pas des fichiers.
Il faut modifier un truc dans ...?
Code: 
 If Not Evaluate("ISREF('" & C & " " & C.Offset(, 1) & "'!A1)") Then Sheets.Add.Name = C & " " & C.Offset(, 1)

            With Sheets(C & " " & C.Offset(, 1))

Merci pour ton énième aide,

Jckbrtn
 
Vote positif 0 Vote négatif
Jacky67

Jacky67

XLDnaute Barbatruc
jckbrtn à dit:
Salut Jacky,

Merci de t'être penché rapidement sur mon problème.
Ca fonctionne sauf que ça créée des feuilles séparés et pas des fichiers.
Il faut modifier un truc dans ...?
Code: 
 If Not Evaluate("ISREF('" & C & " " & C.Offset(, 1) & "'!A1)") Then Sheets.Add.Name = C & " " & C.Offset(, 1)

            With Sheets(C & " " & C.Offset(, 1))

Merci pour ton énième aide,

Jckbrtn
Cliquez pour agrandir...
Re..
Ben...oui ; c'est celui que tu as fourni en PJ #7
J'avais constaté et précisé
On reste donc à la création de feuilles.
Même modif sur celui qui crée des classeurs
 

Pièces jointes

  • Exemple annexe excel.xlsm
    29.1 KB · Affichages: 9
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

J
  • Question
Microsoft 365 Conversion de fichiers word en pdf / VBA
Réponses
1
Affichages
161
kiki29
kiki29
D
  • Question
Microsoft 365 Fonction de Recherche de différents tableaux avec plusieurs résultats ?
2
Réponses
15
Affichages
272
Cousinhub
Cousinhub
L
  • Question
XL 2016 Aide pour données de plusieurs fichiers
Réponses
2
Affichages
254
LudoM28
L
T
  • Résolu(e)
XL 2010 VBA - Lister fichiers et décortiquer le nom des fichiers dans colonne A et B
Réponses
5
Affichages
138
sylvanu
sylvanu
F
  • Résolu(e)
XL 2019 Plusieurs lignes avec mêmes donnés
2
Réponses
23
Affichages
252
DJunqueira
D
Darkopsix
  • Résolu(e)
XL 2021 Récupérer des données de fichiers dons les noms sont renseignés dans des cellules
Réponses
2
Affichages
402
Darkopsix
Darkopsix
king76
  • Question
Autres [RÉSOLU] Excel pour gérer une base de données ?
Réponses
10
Affichages
420
dysorthographie
dysorthographie
M
  • Question
Power Query Nom des onglets des fichiers importés dans Power query
Réponses
13
Affichages
563
Mongo
M
V
  • Question
XL 2021 avoir des données dans plusieurs onglets en fonction de plusieurs conditions
Réponses
5
Affichages
138
mapomme
mapomme
N
  • Question
Microsoft 365 Mise à jour de données d'un fichier Excel à un autre, sous Sharepoint
Réponses
0
Affichages
107
Newbeee
N

Membres actuellement en ligne

15 membres et 102 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 108
Messages
2 085 375
Membres
102 876
dernier inscrit
BouteilleMan