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.
Contactez moi je vous joindrais le également le fichier
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