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

  • Initiateur de la discussion Initiateur de la discussion jckbrtn
  • Date de début Date de début
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

Trier par date Trier par votes
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

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

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

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

Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

Z
  • Résolu(e)
Microsoft 365 Scinder une ligne en fonction de plusieurs critères
Réponses
10
Affichages
248
Zaadox
Z
F
  • Résolu(e)
XL 2021 VBA et Power Query : ecrire des requetes avec variables
2
Réponses
28
Affichages
2 K
Florent74
F
jeanmi
  • Résolu(e)
XL 2013 recherche de données sur plusieurs fichiers
Réponses
13
Affichages
429
dysorthographie
dysorthographie
M
  • Question Question
Microsoft 365 Questions générales Power Query
Réponses
4
Affichages
535
merinos-BernardEtang
merinos-BernardEtang
C
  • Question Question
Autres macros Excel
3 4 5
Réponses
63
Affichages
2 K
Cheminotbelgiantrain
C
edgy63
  • Question Question
Microsoft 365 Remplir cellules à partir de plusieurs fichiers Excel d'un dossier
2
Réponses
17
Affichages
547
alexga78
A
N
  • Résolu(e)
XL pour MAC Erreur à l'enregistrement de plusieurs fichiers Excel
Réponses
5
Affichages
167
Noymie
N
L
  • Question Question
Microsoft 365 recherche X lien entre 2 fichiers
Réponses
3
Affichages
205
lilie17
L
Armisa
  • Résolu(e)
XL 2016 Optimisation des fichiers Excel volumineux
Réponses
4
Affichages
259
Armisa
Armisa
J
  • Question Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
92
JJ69
J
R
  • Question Question
Microsoft 365 Liste des fichiers dans le répertoire
2 3
Réponses
31
Affichages
1 K
patricktoulon
patricktoulon
G
  • Résolu(e)
Microsoft 365 Colorer des cellules automatiquement
Réponses
14
Affichages
484
Gaugau
G
G
  • Résolu(e)
Microsoft 365 Consolidation données depuis des feuilles
Réponses
2
Affichages
277
gpion
G
L
  • Résolu(e)
XL 2016 Pb publipostage conditionnelle avec base de données Excel
Réponses
1
Affichages
284
Linda42
L
R
  • Question Question
XL 2010 Copie de données de plusieurs feuilles dans une seule
Réponses
5
Affichages
627
Renaud22
R
M
  • Résolu(e)
Microsoft 365 Problème Excel Macros Liaison Ppt
Réponses
11
Affichages
357
D. HANIB
D
P
  • Question Question
Microsoft 365 Publipostage avec Excel
Réponses
10
Affichages
442
Sequoyah
Sequoyah
M
  • Résolu(e)
XL 2016 Filtre automatiquement avec VBA excel et powerpoint
2
Réponses
29
Affichages
2 K
melltel
M
jeff1494
  • Question Question
XL 2021 Liste des propriétés de fichiers.
3 4 5
Réponses
73
Affichages
3 K
jeff1494
jeff1494
R
  • Question Question
XL 2010 Copier des lignes de données de plusieurs feuilles dans une seule
Réponses
5
Affichages
505
sylvanu
sylvanu

Membres actuellement en ligne

5 membres et 140 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
315 284
Messages
2 118 014
Membres
113 406
dernier inscrit
NI-ZE