Crétation Fchier Excel avec Filtre VBA

Oulol

XLDnaute Nouveau
Bonjour à tous et tout d'abord merci pour votre présence.
Depuis avant hier je me tire les cheveux sur un programme qui me semblait à première vue pas si compliqué que ça.

Je m'explique plus en détail:

Je dispose d'un classeur Excel comportant deux onglets principaux:

Onglet n°1: Base de donnée indiquant les coûts détaillés plusieurs directions. (Onglet EXTRACT_KE5Z)
Onglet n°2: Liste des directions. (Onglet LISTE_DIRECTION)

Avec ces informations je souhaite filtrer dans la base de donnée (Onglet n°1) et créer un nouveau classeur Excel, le nommer avec le code direction concerné et coller uniquement les données filtrées de la direction concernée.
Je souhaiterais également rajouter automatiquement l'onglet "ANALYSES-COMMENTAIRES"
Pour ce faire j'ai donc créé une boucle qui devait faire le travail.

Si vous pouviez me venir en aide cela serait super et me permettrait de gagner un temps énorme.

Je vous joins le fichier évoqué en question.

Je vous remercie par avance pour votre aide.

Code:
Option Explicit

Sub MAJ()

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim Nom_Fichier As Variant
Dim Extention As Variant
Dim Nom_direction As Variant
Dim finfeuille As Variant
Dim Fin_Direction As Variant
Dim i As Integer
Dim wbMyWb As Workbook


'Alignement des directions

Feuil4.Activate
finfeuille = Range("c1").End(xlDown).Row
Range("a2").FormulaLocal = "=RECHERCHEV(E2;'BASE-CC_DIRECTION'!A:F;3;0)"
Range("a2").Copy
Range("a2:a" & finfeuille).PasteSpecial Paste:=xlPasteFormulas
Range("a2:a" & finfeuille).Copy
Range("a2:a" & finfeuille).PasteSpecial xlPasteValues
Application.CutCopyMode = False

'' Retrait des #N/A
'Feuil4.Columns("a:a").Replace What:="#N/A", Replacement:="0", LookAt:=xlPart _
        , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
'Alignement des enveloppes

finfeuille = Range("c1").End(xlDown).Row
Range("b2").FormulaLocal = "=RECHERCHEV(F2;'BASE_NATURE-ENVELOPPE'!A:B;2;0)"
Range("b2").Copy
Range("b2:b" & finfeuille).PasteSpecial Paste:=xlPasteFormulas
Range("b2:b" & finfeuille).Copy
Range("b2:b" & finfeuille).PasteSpecial xlPasteValues
Application.CutCopyMode = False

' Filtre Direction

Fin_Direction = Feuil6.Range("a1").End(xlDown).Row

For i = 2 To Fin_Direction
Range("$A$1:$L$65000").AutoFilter Field:=1, Criteria1:=Feuil6.Range("a" & Fin_Direction)

' Export et copie des fichiers
   
 Nom_direction = "COUTS_DETAILLES_" & Feuil6.Range("a" & Fin_Direction).Value
 Extention = ".xlsx"
 Nom_Fichier = Nom_direction + Extention
   
    ''On créer l'objet Excel
    Set xlApp = CreateObject("Excel.Application")
    ''On défini le nombre d'onglets (ici 2)
    xlApp.SheetsInNewWorkbook = 2
    ''On ajoute un classeur
    Set xlBook = xlApp.Workbooks.Add
    ''On donne un nom au classeur
    xlBook.SaveAs ("N:\DAPE\3 DCGS\CANA\3- Suivi Enveloppes\09-2014\EXTRACTION_COUTS_DETAILLES\EXPORTS_COUTS_DETAILLES\" & Nom_direction)
    ''On rend le classeur visible
    xlApp.Visible = True
    ''On créer l'objet onglet dans le nouveau classeur créé
    Set xlSheet = xlBook.Worksheets(1)
    ''On affecte un nom aux l'onglets
    xlSheet.Name = "COUTS_DETAILLES"
    ''on libère l'objet onglet pour pouvoir en créer un nouveau ... etc
    Set xlSheet = Nothing
        Set xlSheet = xlBook.Worksheets(2)
    xlSheet.Name = "ANALYSES-COMMENTAIRES"
    
  Windows("COUTS_DETAILLES_PAR_DIRECTION.xlsm").Activate
  Feuil4.Range("a1:l65000").Copy
    
 MsgBox Nom_Fichier
Workbooks(Nom_Fichier).Activate
 
  Sheets("COUTS_DETAILLES").Activate
  Range("a2").Paste
  
Next

End Sub

Contactez moi je vous joindrais le également le fichier
 

titiborregan5

XLDnaute Accro
Re : Crétation Fchier Excel avec Filtre VBA

Bonjour Oulol,

si j'ai bien compris tu souhaites à partir d'une base de données créer un fichier par direction et renseigner les infos qui lui sont liées?

Pour cela utilise un modèle et le filtre élaboré (advancedfilter en VBA) qui te fera ça en 2 temps 3 mouvements...

A+
 

titiborregan5

XLDnaute Accro
Re : Crétation Fchier Excel avec Filtre VBA

Re,

la coutume sur ce forum est de mettre un fichier exemple au message.
Je ne souhaite pas de fichier qui me soit directement adressé mais posté ici, pour tous les membres, afin que tout le monde puisse t'aider...

Je te laisse poster un fichier exemple représentatif de ton fichier réel (surtout au niveau du format), anonymisé of course et avec pourquoi pas le résultat souhaité!

A+
 

Discussions similaires

Réponses
6
Affichages
202

Statistiques des forums

Discussions
311 709
Messages
2 081 766
Membres
101 815
dernier inscrit
sgep59