Exporter des données selon 1 critère avec création de fichier

[perdinch]

Bonsoir

A partir d'une table de données contenant 20000 lignes, je souhaite filtrer des données par MAGASIN (il peu y en avoir jusqu'a 300 )selon un critère et les exporter les résultats dans un classeur pour chaque extraction avec VBA.

Le fichier exemple en PJ sera plus explicite

Merci de vos suggestions

 

[Nairolf]

Re : Exporter des données selon 1 critère avec création de fichier

Salut perdinch,

Je te propose une base de code pour te permettre de faire ça:

Sub Macro1()
    ActiveSheet.Range("$A$1:$B$14").AutoFilter Field:=1, Criteria1:="Magasin1"
    Range("A1:B1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:="C:\test1.xls" _
        , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

Tu n'as plus qu'à l'adapter à ton fichier complet, sachant que tu peux aussi faire le filtre et la sélection à copier manuellement.

 

[perdinch]

Re : Exporter des données selon 1 critère avec création de fichier

MERCI je vais tester

 

[Paf]

Re : Exporter des données selon 1 critère avec création de fichier

Bonjour à tous

en utilisant le code de Nairolf, que j'ai un peu adapté, ci dessous le code qui boucle sur tous les magasins , filtre et copie.

Sub perdinch()

Dim DerLig As Long, MonDico, Tableau, i As Integer, NomFichier As String
Dim BookInit As Workbook, WS1 As Worksheet

Set MonDico = CreateObject("Scripting.Dictionary")
Set BookInit = ActiveWorkbook
Set WS1 = BookInit.Worksheets("Feuil1")

DerLig = WS1.Range("A" & Rows.Count).End(xlUp).Row
'récupération des noms de magasins sans doublon
  Tableau = WS1.Range("A2:A" & DerLig)
  For i = LBound(Tableau) To UBound(Tableau)
     If Tableau(i, 1) <> "" Then MonDico(Tableau(i, 1)) = ""
  Next i
  Erase Tableau
   Tableau = MonDico.keys
   
' pour chaque magasin
For i = LBound(Tableau) To UBound(Tableau)
'macro  Nairolf

    WS1.Range("A1:B" & DerLig).AutoFilter Field:=1, Criteria1:=Tableau(i)
    WS1.Range("A1:B" & DerLig).Copy
    Workbooks.Add
    ActiveSheet.Paste
    Application.CutCopyMode = False
    NomFichier = "C:\" & Tableau(i) & ".xls"
    ActiveWorkbook.SaveAs Filename:=NomFichier ', FileFormat:=xlExcel8
' fin macro  Nairolf
Next
    WS1.ShowAllData
End Sub

A+

 

[perdinch]

Re : Exporter des données selon 1 critère avec création de fichier

MERCI ca fonctionne parfaitement