Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Eclater une feuille en plusieurs et les recompiler en synthèse

Eclater une feuille en plusieurs et les recompiler en synthèse

11 réponses
Avatar
mcl...
Bonjour Í  tous,

Je vous explique mon problème.

J'ai une feuille qui contient environ 20 ou 40 000 lignes de données extraites d'une base de données.
J'utilise une procédure donnée par MichDenis qui me répartie les données de tous les vendeurs dans des feuilles Í  leurs noms.
Avant d'éclater mes données, j'atoute une colonne commentaire.
Je souhaite recompiler toutes les feuilles des vendeurs en une seule mais qui cette fois contient les infos mises en commentaires.

En fait je voudrais éclater mes données en plusieurs feuilles et parfois j'ai besoin de les recompiler pour faire des bilans.


Autre solutions, de ma feuille principale, créer au tant de classeur que j'ai de nom de Vendeurs que je peux ensuite recompiler : plusieurs classeurs en un seul....

Je ne sais pas si je suis clair ?
Et la je suis bloquer.

Un grand merci d'avance.

Mclain
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
MichD
Le 20/11/21 Í  16:32, a écrit :
Bonjour Í  tous,
Je vous explique mon problème.
J'ai une feuille qui contient environ 20 ou 40 000 lignes de données extraites d'une base de données.
J'utilise une procédure donnée par MichDenis qui me répartie les données de tous les vendeurs dans des feuilles Í  leurs noms.
Avant d'éclater mes données, j'atoute une colonne commentaire.
Je souhaite recompiler toutes les feuilles des vendeurs en une seule mais qui cette fois contient les infos mises en commentaires.
En fait je voudrais éclater mes données en plusieurs feuilles et parfois j'ai besoin de les recompiler pour faire des bilans.
Autre solutions, de ma feuille principale, créer au tant de classeur que j'ai de nom de Vendeurs que je peux ensuite recompiler : plusieurs classeurs en un seul....
Je ne sais pas si je suis clair ?
Et la je suis bloquer.
Un grand merci d'avance.
Mclain

Bonjour,
Pour compiler toutes les données dans une même feuille du classeur :
'----------------------------------------
Sub Compiler_Données()
Dim Sh As Worksheet, DerCol As Long
Dim DerLig As Long, NbRows As Long
'Nom de la feuille de compilation de données : "Compilation"
For Each Sh In Worksheets
If Sh.Name <> "Compilation" Then
With Sh
DerCol = .Cells.Find("*", LookIn:=xlFormulas, _
SearchOrder:=xlByColumns,
SearchDirection:=xlPrevious).Column
DerLig = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
With .Range(.Range("A1"), .Cells(DerLig, DerCol))
.Copy Worksheets("Compilation").Range("A1").Offset(NbRows)
NbRows = NbRows + .Count
End With
End With
End If
Next
End Sub
'----------------------------------------
MichD
Avatar
MichD
Le 20/11/21 Í  16:32, a écrit :
Bonjour Í  tous,
Je vous explique mon problème.
J'ai une feuille qui contient environ 20 ou 40 000 lignes de données extraites d'une base de données.
J'utilise une procédure donnée par MichDenis qui me répartie les données de tous les vendeurs dans des feuilles Í  leurs noms.
Avant d'éclater mes données, j'atoute une colonne commentaire.
Je souhaite recompiler toutes les feuilles des vendeurs en une seule mais qui cette fois contient les infos mises en commentaires.
En fait je voudrais éclater mes données en plusieurs feuilles et parfois j'ai besoin de les recompiler pour faire des bilans.
Autre solutions, de ma feuille principale, créer au tant de classeur que j'ai de nom de Vendeurs que je peux ensuite recompiler : plusieurs classeurs en un seul....
Je ne sais pas si je suis clair ?
Et la je suis bloquer.
Un grand merci d'avance.
Mclain

Bonjour,
2 procédures dont l'une ne copie que les données sans les formats de
cellules.
'----------------------------------------
Sub Compiler_Données()
Dim Sh As Worksheet, DerCol As Long
Dim DerLig As Long, NbRows As Long, ShC As Worksheet
Application.EnableEvents = False
Application.ScreenUpdating = False
'Nom de la feuille de compilation de données : "Compilation"
'lÍ  o͹ les données seront copiées, Si la feuille n'existe pas,
'elle est créée
On Error Resume Next
Set ShC = Worksheets("Compilation")
If Err <> 0 Then
Err = 0
Set ShC = Worksheets.Add(After:=Worksheets(Worksheets.Count))
ShC.Name = "Compilation"
Else
Worksheets("Compilation").UsedRange.Delete
End If
For Each Sh In Worksheets
If Sh.Name <> "Compilation" Then
With Sh
DerCol = .Cells.Find("*", LookIn:=xlFormulas, _
SearchOrder:=xlByColumns,
SearchDirection:=xlPrevious).Column
DerLig = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
With .Range(.Range("A1"), .Cells(DerLig, DerCol))
.Copy Worksheets("Compilation").Range("A1").Offset(NbRows)
NbRows = NbRows + .Rows.Count
End With
End With
End If
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'----------------------------------------
Sub Compiler_Données_Sans_Format()
Dim Sh As Worksheet, DerCol As Long, Y As Variant
Dim DerLig As Long, NbRows As Long, ShC As Worksheet
Application.EnableEvents = False
Application.ScreenUpdating = False
'Nom de la feuille de compilation de données : "Compilation"
'lÍ  o͹ les données seront copiées, Si la feuille n'existe pas,
'elle est créée
On Error Resume Next
Set ShC = Worksheets("Compilation")
If Err <> 0 Then
Err = 0
Set ShC = Worksheets.Add(After:=Worksheets(Worksheets.Count))
ShC.Name = "Compilation"
Else
Worksheets("Compilation").UsedRange.Delete
End If
For Each Sh In Worksheets
If Sh.Name <> "Compilation" Then
With Sh
DerCol = .Cells.Find("*", LookIn:=xlFormulas, _
SearchOrder:=xlByColumns,
SearchDirection:=xlPrevious).Column
DerLig = .Cells.Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
With .Range(.Range("A1"), .Cells(DerLig, DerCol))
Y = .Value
ShC.Range("A1").Offset(NbRows).Resize(UBound(Y, 1),
UBound(Y, 2)) = Y
NbRows = NbRows + .Rows.Count
End With
End With
End If
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'----------------------------------------
MichD
Avatar
MichD
À la fin des 2 procédures, tu pourrais ajouter une ligne de code comme
ceci, afin d'ajuster toutes les colonnes selon leur contenu.
ShC.UsedRange.EntireColumn.AutoFit '<<<====Ligne ajoutée
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
MichD
Avatar
mcl...
Bonsoir MichD !
Encore un grand merci Í  toi !
Ton premier script, fait la compilation de la 1er feuille et s'arrête Í  cette ligne :
.Copy Worksheets("Compilation").Range("A1").Offset(NbRows)
J'utilise le second qui me garde les formats de cellules ! Top !
Si veux aller plus loin, en faisant une autre demande...
Ma compilation est modifiée et mise Í  jour... Si je veux cette fois, créer autant de classeur que j'ai de commerciaux, tout en gardant le format des colonnes, au changement de commercial qui se trouve en colonne B, par exemple... J'ai regardé sur Internet mais cela ne fonctionne pas de manière si simple...
sans vouloir abuser...
Merci encore !
Le dimanche 21 novembre 2021 Í  13:03:03 UTC+1, MichD a écrit :
À la fin des 2 procédures, tu pourrais ajouter une ligne de code comme
ceci, afin d'ajuster toutes les colonnes selon leur contenu.
ShC.UsedRange.EntireColumn.AutoFit '<<<====Ligne ajoutée
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
MichD
Avatar
MichD
Le 21/11/21 Í  16:05, a écrit :
Bonsoir MichD !
Encore un grand merci Í  toi !
Ton premier script, fait la compilation de la 1er feuille et s'arrête Í  cette ligne :
.Copy Worksheets("Compilation").Range("A1").Offset(NbRows)
J'utilise le second qui me garde les formats de cellules ! Top !
Si veux aller plus loin, en faisant une autre demande...
Ma compilation est modifiée et mise Í  jour... Si je veux cette fois, créer autant de classeur que j'ai de commerciaux, tout en gardant le format des colonnes, au changement de commercial qui se trouve en colonne B, par exemple... J'ai regardé sur Internet mais cela ne fonctionne pas de manière si simple...
sans vouloir abuser...
Merci encore !
Le dimanche 21 novembre 2021 Í  13:03:03 UTC+1, MichD a écrit :
À la fin des 2 procédures, tu pourrais ajouter une ligne de code comme
ceci, afin d'ajuster toutes les colonnes selon leur contenu.
ShC.UsedRange.EntireColumn.AutoFit '<<<====Ligne ajoutée
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
MichD


Dans le tout premier script, ces 2 lignes de code :
.Copy Worksheets("Compilation").Range("A1").Offset(NbRows)
NbRows = NbRows + .Count
Devraient se lire ainsi :
.Copy Worksheets("Compilation").Range("A1").Offset(NbRows)
NbRows = NbRows + .rows.Count '<<<====modifier
Un fichier exemple sur les 2 procédures publiées dans le même message,
et d'après mes tests, il n'y a aucun problème avec aucune d'elles.
https://www.cjoint.com/c/KKvvxz8VYCF
MichD
Avatar
MichD
Le 21/11/21 Í  16:05, a écrit :
Bonsoir MichD !
Encore un grand merci Í  toi !
Ton premier script, fait la compilation de la 1er feuille et s'arrête Í  cette ligne :
.Copy Worksheets("Compilation").Range("A1").Offset(NbRows)
J'utilise le second qui me garde les formats de cellules ! Top !
Si veux aller plus loin, en faisant une autre demande...
Ma compilation est modifiée et mise Í  jour... Si je veux cette fois, créer autant de classeur que j'ai de commerciaux, tout en gardant le format des colonnes, au changement de commercial qui se trouve en colonne B, par exemple... J'ai regardé sur Internet mais cela ne fonctionne pas de manière si simple...
sans vouloir abuser...

| créer autant de classeur que j'ai de commerciaux
Tu peux utiliser cette procédure:
Attention : Je nomme la feuille dans le nouveau classeur du nom du
commercial. J'ai supposé que ces noms n'avaient pas plus de 30
caractères. De plus, certains caractères ne sont pas permis dans le nom
des onglets des feuilles. Il en est de même pour le nom des classeurs
qui portent aussi le nom du commercial.
Si cela bloque, il faudra ajouter du code pour détecter ces caractères
et les supprimer ou les remplacer.
Renseigne les variables dans la procédure, selon ton environnement.
La ligne 1 est censée contenir les étiquettes de colonnes.
'---------------------------------------------------------------
Sub Exporter_Commerciaux_Vers_Classeur()
Dim Sh As Worksheet, Rg As Range, C As Range
Dim D As Object, Wk As Workbook
Dim Chemin As String, K As Variant
'Nom de l'onglet o͹ sont les données des commerciaux
Set Sh = Worksheets("données")
'Endroit o͹ tu veux enregistrer chacun des classeurs
Chemin = "F:Test"
With Sh
Set Rg = .Range("B1:B" & .Range("B" & .Rows.Count).End(xlUp).Row)
End With
Set D = CreateObject("Scripting.Dictionary")
For Each C In Rg
If C.Row <> 1 Then ' 1 la ligne d'étiquette de colonne
If Not D.Exists(C.Value) Then
D.Add C.Value, C.Address
End If
End If
Next
'Si un fichier existe déjÍ  du même nom dans le répertoire
'il sera écrasé par le nouveau fichier
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each K In D.Keys
With Rg
.AutoFilter Field:=1, Criteria1:=K
Set Wk = Workbooks.Add
Wk.Worksheets(1).Name = K
Set Data = Rg.SpecialCells(xlCellTypeVisible).EntireRow
Data.Copy Wk.Worksheets(1).Range("A1")
Wk.SaveAs Chemin & K & ".xlsx"
Wk.Close False
End With
Next
Rg.AutoFilter
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
'---------------------------------------------------------------
MichD
Avatar
MichD
C'est le même fichier que précédemment, mais, j'ai corrigé une petite
coquille, évité que la ligne d'étiquettes des colonnes de chacune des
feuilles se recopie dans la feuille de compilation.
https://www.cjoint.com/c/KKwnRdd8XqF
MichD
Avatar
mcl...
Le lundi 22 novembre 2021 Í  14:46:56 UTC+1, MichD a écrit :
C'est le même fichier que précédemment, mais, j'ai corrigé une petite
coquille, évité que la ligne d'étiquettes des colonnes de chacune des
feuilles se recopie dans la feuille de compilation.
https://www.cjoint.com/c/KKwnRdd8XqF
MichD

Bonjour MichD,
Merci pour la 'coquille' ce qui n'était pas grave.
Le top est la conservation des formats, couleurs !
Est-il possible aussi de garder les filtres dans chaque feuille ainsi crées et de figer l'affichage en A2 pour garder la ligne d'étiquette, la aussi sur chaque feuille ?
Encore merci pour ton aide, tes solutions !
John
Avatar
MichD
Est-il possible aussi de garder les filtres dans chaque feuille ainsi crées et de figer l'affichage en A2 pour garder la ligne d'étiquette, la aussi sur chaque feuille ?

Je ne comprends pas ta question.
Si les feuilles ont des filtres, la copie des données de ces feuilles
n'affecte pas le filtre...
Dans la feuille "Compilation", il ne peut pas y avoir plus d'un filtre
automatique par feuille.
MichD
Avatar
mcl...
Le lundi 22 novembre 2021 Í  15:41:00 UTC+1, MichD a écrit :
Est-il possible aussi de garder les filtres dans chaque feuille ainsi crées et de figer l'affichage en A2 pour garder la ligne d'étiquette, la aussi sur chaque feuille ?
Je ne comprends pas ta question.
Si les feuilles ont des filtres, la copie des données de ces feuilles
n'affecte pas le filtre...
Dans la feuille "Compilation", il ne peut pas y avoir plus d'un filtre
automatique par feuille.
MichD

Bonsoir MichD,
En fait j'ai une opération A qui me permet de répartir les données d'une feuille principales en autant de feuilles que j'ai de commerciaux avec ce script :
Dans ce script, est-il possible de rajouter :
1 - figer l'affichage en A2 dans chaque nouvelle feuille ainsi créee
2 - d'activer les filtres sur chaque page
3 - est-il possible au lancement de la macro, que celle-ci me demande qu'elle colonne contient la donnée Commerciaux en lieu et place de
With Worksheets("Sheet1") ' Nom Í  adapter
'adresse de la colonne o͹ sont les agents -> ͠ adapter
With .Range("B1:B" & .Range("B65536").End(xlUp).Row)
Et une opération de recompilation avec le script que tu m'as fait et qui fonctionne trop bien !
-------- script de répartition
Sub test()
Dim Arr(), Rg As Range, C As Range, A As Integer
Dim DerCol As Integer, DerLig As Long, Elt As Variant
Dim Sh As Worksheet, NomFeuille As String
Application.EnableEvents = False
Application.ScreenUpdating = False
NomFeuille = ActiveSheet.Name
With Worksheets("Sheet1") ' Nom Í  adapter
'adresse de la colonne o͹ sont les agents -> ͠ adapter
With .Range("B1:B" & .Range("B65536").End(xlUp).Row)
.AdvancedFilter xlFilterInPlace, , , True
For Each C In .Offset(1).Resize(.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible)
A = A + 1
ReDim Preserve Arr(1 To A)
Arr(A) = C.Value
Next
End With
.ShowAllData
DerCol = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
DerLig = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'Il est pris pour acquis que ton tableau débute en A1
Set Rg = .Range("A1", .Cells(DerLig, DerCol))
End With
On Error Resume Next
For Each Elt In Arr
Err = 0
Set Sh = Worksheets(Elt)
If Err = 0 Then
Sh.Cells.Clear
Else
Err = 0
Set Sh = Worksheets.Add(after:=Sheets(Sheets.Count))
Sh.Name = Elt
End If
With Rg
.AutoFilter field:=2, Criteria1:=Elt
.SpecialCells(xlCellTypeVisible).Copy Sh.Range("A1")
End With
Next
Rg.AutoFilter
Worksheets(NomFeuille).Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Function DerLig(Sh As Worksheet)
On Error Resume Next
DerLig = Sh.Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
On Error GoTo 0
End Function
********** PAR FONCTION dERNIÈRE Colonne **************
Function DerCol(Sh As Worksheet)
On Error Resume Next
DerCol = Sh.Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
On Error GoTo 0
End Function
Merci MicHD !
1 2