Extraction donnee depuis filtre
Bonjour
Je démarre en VBA (Merci au site pour ses précieux conseils), mais je bloque (certainement une chose très simple !)
Un tableau de 3 colonnes avec filtre, je souhaite extraire sur des feuilles séparées dans le classeur les données correspondantes à la colonne C (Nom)
Début de code qui fonctionne mais, un souci de résultat :
La macro me génère 12 feuilles ???, sur les extraction (ici nom A et B, cela me laisse les lignes vide.
1-Comment supprimer ces lignes vides?
2- Comment automatiser le filtre car je ne connais pas forcement le nom (qui est ici inscrit dans le code)
Merci de votre rtour
Bonjour,
Une proposition à étudier.
Les données sont mises sous forme de tableaux.
Cdlt.
Public Sub Filter_Data()
Dim wb As Workbook
Dim ws As Worksheet, wsData As Worksheet, wsNew As Worksheet
Dim lo As ListObject, lo2 As ListObject
Dim lRow As Long
Dim Cell As Range
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
Set wb = ActiveWorkbook
Set wsData = wb.Worksheets("Données")
Set lo = wsData.ListObjects(1)
For Each ws In wb.Worksheets
If ws.Name <> wsData.Name Then ws.Delete
Next ws
Application.DisplayAlerts = True
If lo.ShowAutoFilter Then lo.AutoFilter.ShowAllData
Set ws = wb.Worksheets.Add
With ws
lo.ListColumns(3).Range.AdvancedFilter _
Action:=xlFilterCopy, _
copytorange:=.Cells(1), unique:=True
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For Each Cell In .Cells(2, 1).Resize(lRow - 1)
lo.Range.AutoFilter field:=3, Criteria1:=Cell.Value
Set wsNew = wb.Worksheets.Add(after:=Worksheets(Worksheets.Count))
wsNew.Name = Cell.Value
lo.Range.SpecialCells(xlCellTypeVisible).Copy
With wsNew
With .Cells(1)
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
Set lo2 = .ListObjects.Add(xlSrcRange, .Cells(1).CurrentRegion, , xlYes)
With lo2
.Name = "T_" & Cell.Value
.TableStyle = "TableStyleLight11"
End With
End With
lo.Range.AutoFilter field:=3
Next Cell
End With
Application.DisplayAlerts = False
ws.Delete
With wsData
.Activate
.Cells(1).Select
End With
MsgBox "Les onglets ont été crées!...", vbInformation, "Création onglets"
End SubBonjour
Pourquoi ne pas tout simplement automatiser un filtre avancé ?
VAR étant un mot réservé de VBA, évite de l'utiliser pour un nom de variable.
Edit : salut Jean-Eric plus rapide à répondre
Je regarde tout ca et vous tiens au courant
Merci en tout cas
Bonjour 78chris,
Tu a écrit :VAR étant un mot réservé de VBA
Pour moi, var n'est pas un mot-clé de VBA, mais c'est une fonction d'Excel qui peut être appelée depuis VBA par : WorksheetFunction.Var() ; cette fonction Var() retourne la Variance (= écart-type) ; cf cours de statistiques.
Ceci dans ma version d'Excel 2007 ; peut-être que var est devenu un mot-clé de VBA dans les versions ultérieures ?
(ne pas confondre le mot-clé Var du langage Pascal ou Delphi avec Dim de VBA !)
dhany
Bonjour
Effectivement c'est une fonction Excel appelable depuis VBA comme tu le précises avec justesse
De façon générale je conseille d'éviter les noms qui interfèrent avec ceux que VBA manipule (de même qu'en base de données je déconseille de nommer un champ Date...)
Bonjour
En "bricolant" et en cherchant un peu par rapport à vos réponses, j'ai réussi à mettre en place ce que j'avais besoin.
Merci
Je progresse .... (y'a encore du boulot
Régis
Bonsoir,
Sub Extrait()
Set f = Sheets("BD")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'--- Liste des noms
f.[A1:C10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=f.[G1], Unique:=True
For Each c In f.Range("G2:G" & f.[G65000].End(xlUp).Row) ' pour chaque nom
f.[G2] = c.Value
On Error Resume Next
Sheets(c.Value).Delete
On Error GoTo 0
Sheets.Add After:=Sheets(Sheets.Count) ' création
ActiveSheet.Name = c.Value
'-- extraction
f.[A1:C10000].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=f.[G1:G2], CopyToRange:=[A1]
Next c
End Sub
cf PJCeuzin
Merci
Ce que j'avais fait me convenait (avec une contrainte cependant), la , ça ma l'air parfait.
Je vais tester avec mon fichier
Régis
Bonjour
Après modification, souci a l’exécution, il n'extrait que la première ligne avec comme nom le nom de la colonne.
De plus il efface l'ensemble des valeurs dans la colonne de recherche.
Si quelqu'un pouvait me dire ce qui coince et comment corriger (certainement très simple mais.....)
Merci
En pj mon fichier (test liste)
Bonjour,
Une nouvelle proposition identique à la précédente.
Les données sont sous forme de tableau.
Cdlt.
C'est parfait
Je vais regarder le code en détail afin de comprendre (c'est mon but) !
Merci
Bonsoir
Dans le fichier joint (test liste internet) cela fonctionne parfaitement, mais quand je recopie le code pour le mettre dans mon fichier, j'ai une erreur
Je ne comprends pas
Une explication? (certainement mais cela dépasse mes compétences..)
Merci
Bonsoir Régis,
Tu as : Set lo = wsData.ListObjects(1) ; pour lo : Dim lo As ListObject ➯ OK
Pour ws.Data : Dim ws As Worksheet et Set wsData = ActiveSheet ➯ OK
en plus que la feuille active existe forcément : ça peut pas être une feuille inexistante !
mais attention : cette feuille active doit être celle de ton tableau !
Pour wsData.ListObjects(1) : comme indiqué ci-dessus, wsData est OK, donc l'erreur ne peut provenir que de ListObjects(1)
ListObjects(1) est le 1er tableau de ta feuille active, et cette feuille active (à partir de laquelle tu lances la macro) doit être la feuille "Numéro AS" ... car pour cette feuille, il y a le nom défini "Tableau1", qui fait référence à : ='Numéro AS'!$A$2:$L$99
(pour le voir, fais Ctrl F3 ➯ fenêtre "Gestionnaire de noms")
Donc dans ton vrai fichier, il faut qu'il y aie le même nom défini "Tableau1", avec la même référence !
Et n'oublie pas de lancer la macro à partir de la feuille "Numéro AS" !
dhany
Bonsoir
Merci du retour rapide.
Malgré suivi des indications, j'ai bien renommé en Tableau1 de A2 vers L99
Recopié le code dans mon fichier, et lancement depuis la page active Numéro AS
J'ai toujours la même erreur , jai fait quelques modifs pour essayer mais rien ne marche.
Je sèche complètement
Régis
Dans ce cas, au lieu du fichier texte "EXTRACT PAR ONGLET.txt",
envoie ton classeur "EXTRACT PAR ONGLET.xlsm".
J'essayerai alors de trouver une solution.
Ok, voici mon fichier.
Le souci viens bien en effet de cette zone de nom mais je ne comprends pas pourquoi
Dans le fichier d'origine figure un marquage sur cette zone (en ligne 1 et 99), dans le fichier joint je n'ai pas cela.
Sinon autre question , c'est un fichier que je dois traiter chaque semaine qui m'est fourni en extraction d'une base de données, il évolue donc, il faudra donc inclure dans la macro la zone de nom (ici tableau1) sur du contenu de la feuille Numéro AS?
Merci de ton aide et des explications, j'en apprends un peu plus chaque jour
Régis
Je te retourne ton fichier Excel modifié :
À l'ouverture du fichier, note bien qu'il y a seulement l'onglet "Numéro AS" (oui, je sais : rien de neuf pour l'instant !
Exécute la macro ➯ fenêtre « Création d'onglets » (avec son message), et là est la nouveauté ! non, non, je parle pas du « d' » ajouté devant « onglets », c'est mieux que ça : sans fermer la fenêtre, regarde à droite de ton onglet de départ "Numéro AS" : oh ! il a fait des petits !!!
Alt F11 pour voir le code VBA (que j'ai beaucoup modifié) ; mais le bug ne venait pas du code VBA lui-même ! ça venait de ce que ton tableau était une simple plage de cellules et non pas un vrai tableau (de type ListObject, et qu'on appelait Listes dans Excel 2003).
Quand on veut créer un tel tableau, il faut sélectionner la simple plage de cellules où tu as mis ton tableau simple, puis : onglet Insertion, groupe Tableaux, Tableau (voir l'aide Excel pour plus d'infos).
Ça explique ta phrase : « Dans le fichier d'origine figure un marquage sur cette zone (en ligne 1 et 99), dans le fichier joint je n'ai pas cela. »
Petit bonus supplémentaire : quand tu vas sur les autres onglets, seule la cellule A1 est sélectionnée et pas tout le tableau ; ça fait plus propre et c'est plus sûr, car si par exemple tu appuies sur la touche Suppr, ça efface que A1 et pas toute la sélection !
Pour ton fichier qui est une extraction de base de données, il faudrait effectivement transformer la plage de cellules simple en vrai tableau de type ListObjet ; pour ça je te laisse faire (ou le voir avec Jean-Eric) ; bonne chance !
dhany
Bonjour,
J'ai modifié le fichier en ajoutant la création du tableau (T_Données) si nécessaire.
---> Lignes normalement surlignées ci-dessous.
Cdlt.
Public Sub Filter_Data()
Dim wb As Workbook
Dim ws As Worksheet, wsData As Worksheet, wsNew As Worksheet
Dim lo As ListObject, lo2 As ListObject
Dim lRow As Long
Dim Cell As Range
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
Set wb = ActiveWorkbook
Set wsData = ActiveSheet
wsData.Name = wsData.Cells(3).Text
[Surligner] With wsData
If .Cells(1).ListObject Is Nothing Then
Set lo = .ListObjects.Add(xlSrcRange, .Cells(1).CurrentRegion, , xlYes)
With lo
.Name = "T_Données"
.TableStyle = "TableStyleLight11"
End With
Else
Set lo = .ListObjects(1)
End If
End With
[/Surligner]
For Each ws In wb.Worksheets
If ws.Name <> wsData.Name Then ws.Delete
Next ws
Application.DisplayAlerts = True
If lo.ShowAutoFilter Then lo.AutoFilter.ShowAllData
Set ws = wb.Worksheets.Add
With ws
lo.ListColumns(12).Range.AdvancedFilter _
Action:=xlFilterCopy, _
copytorange:=.Cells(1), unique:=True
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For Each Cell In .Cells(2, 1).Resize(lRow - 1)
lo.Range.AutoFilter field:=12, Criteria1:=Cell.Value
Set wsNew = wb.Worksheets.Add(after:=Worksheets(Worksheets.Count))
wsNew.Name = Cell.Value
lo.Range.SpecialCells(xlCellTypeVisible).Copy
With wsNew
With .Cells(1)
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteValuesAndNumberFormats
End With
Application.CutCopyMode = False
Set lo2 = .ListObjects.Add(xlSrcRange, .Cells(1).CurrentRegion, , xlYes)
With lo2
.Name = "T_" & Cell.Value
.TableStyle = "TableStyleLight11"
End With
End With
lo.Range.AutoFilter field:=12
Next Cell
End With
Application.DisplayAlerts = False
ws.Delete
With wsData
.Activate
.Cells(1).Select
End With
MsgBox "Les onglets ont été crées!...", vbInformation, "Création onglets"
End SubBonjour
Merci à vous, testé sur plusieurs fichiers et cela fonctionne.
Me reste plus qu'a intégrer dans ce code une macro avec condition (coloration cellule ...).
Macro déjà crée et qui fonctionne seule de son coté, ca ne devrait pas être trop compliqué (au moins de mon niveau !)
Je prends note de vos conseils et remarques .
Régis