XL 2016 VBA exporter d'un tableau structuré vers plusieurs nouveau classeurs

MickaelKeul

XLDnaute Nouveau
Apres l'import ... l'export !

J'ai un fichier avec un tableau structuré qui contient des données de plusieurs fournisseurs. Je cherche a créer plusieurs nouveau fichier (1 par fournisseur) qui reprend unique les données correspondant a chaque fournisseurs.
Le code VBA que j'ai fait arrive a filtrer et créer chaque fichier mais le problème c'est que ça me copie ces nouveaux fichiers l'intégralité des données ...
Je sèche car je pensais (et lu) que "DataBodyRange" ne sélectionnait que les données filtrées

Private Sub Exporter()

' **********************************
' Exporter les négos Fournisseurs
' **********************************

Dim Unique As Object
Dim DerLigne As Integer, DerColonne As Integer
Dim Plage As Range, c As Range
Dim Valeur


Set Unique = CreateObject("Scripting.Dictionary")


For Each c In Feuil1.ListObjects("BaseArticles").ListColumns("Fournisseur").DataBodyRange

If Not Unique.Exists(c.Value) Then Unique.Add c.Value, c.Value

Next c

For Each Valeur In Unique.keys

Feuil1.ListObjects("BaseArticles").Range.AutoFilter Field:=2, Criteria1:=Valeur

Workbooks.Add
Application.Dialogs.Item(xlDialogSaveAs).Show Valeur & "_OK"

Feuil1.ListObjects("baseArticles").HeaderRowRange.Copy [a1]
Feuil1.ListObjects("baseArticles").DataBodyRange.Copy [a2]


' Masque des colonnes
Range("a:c").EntireColumn.Hidden = True


' test protection cellules
ActiveSheet.Unprotect
Range("a1:ab2000").Locked = False
Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).row, 22)).Select
Selection.Locked = True

ActiveSheet.Protect 1234

ActiveWorkbook.Save

ThisWorkbook.Activate
Next


End Sub
 

Pièces jointes

  • Test-Outil.xlsm
    26.9 KB · Affichages: 14

Discussions similaires

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 848
dernier inscrit
Djigbenou