Création d'un fichier par macro avec intégration d'une nouvelle macro

[Ben Becker]

Bonjour à tous,

je vous sollicite pour un problème que je n'arrive à régler (encore faut-il qu'il soit réalisable) : j'utilise une macro 1 qui a pour but d'extraire les données d'un fichier excel (fichier source) dans un nouveau fichier (fichier créé par cette macro 1). Jusque là tout va bien.
Je voudrais qu'en plus de la création de ce nouveau fichier excel, celui-ci copie colle une macro 2 qui est dans le fichier source.
Si quelqu'un peut m’éclairer sur cette problématique ca serait vraiment gentil.

Merci beaucoup pour votre aide.

 

[laurent950]

Re : Création d'un fichier par macro avec intégration d'une nouvelle macro

Bonsoir Ben Becker,

Pouvais vous envoyer votre fichier source (le nom de la feuilles a dupliquer dans un nouveau classeur crée de toute pièces) et ajouter les macro dans se nouveau classeur (avec le nom de se classeur aprés enregistrement) et sous qu'elle version l'enregistrer (soir .xls ou xlsx ou xlsm etc.)

Je pense que cela est réalisable

laurent

 

[Ben Becker]

Re : Création d'un fichier par macro avec intégration d'une nouvelle macro

Bonjour,

Je vous joins un fichier excel avec les 2 macros (macro 1 qui permet d'extraire les données dans des nouveaux fichiers) et la macro 2 que je souhaite dupliquer dans les nouveaux fichiers...

Merci de votre aide,

Ben B.

 

[TempusFugit]

Re : Création d'un fichier par macro avec intégration d'une nouvelle macro

Bonjour


Pourquoi ne pas simpliment de pas copier le classeur en cours (ce qui copiera les macros automatiquement) en faisant l'extraction sur la copie et en supprimant les feuilles inutiles ?

 

[Ben Becker]

Re : Création d'un fichier par macro avec intégration d'une nouvelle macro

La solution a mon probleme me parait bonne mais à condition que lors de l'extraction de mes fichiers la macro 1 reste conforme.

Comment puis-je procéder?
merci de votre aide,

Ben

 

[TempusFugit]

Re : Création d'un fichier par macro avec intégration d'une nouvelle macro

Si j'ai bien compris, ta macro crée autant de classeurs qu'il y a de valeurs uniques dans ta colonne B?

Si oui

Plutot que de créer des classeurs, tu copies ton extraction dans une feuille nouvellement créée dans le meme classeur
et tu fais l'équivalent d'un Enregistrer sous (en supprimant aux préalable les feuilles en trop)
et tu mets le code de ta macro dans un module standard et pas dans le code de ta feuille
Ainsi chaque classeur enregistré gardera le module standard du classeur initial.

 

[Ben Becker]

Re : Création d'un fichier par macro avec intégration d'une nouvelle macro

Merci pour ton aide,
Oui c'est bien ce que la macro fait (autant de classeurs que de valeurs uniques).
Mais comment puis-je restrancrire ce que tu dis en langage VBA? car je suis pas hyper calé...
le deuxieme partie ressemble à ce que je veux!

merci d'avance,

Ben

 

[Ben Becker]

Re : Création d'un fichier par macro avec intégration d'une nouvelle macro

Bonjour,

j'ai essayer de retravailler ma macro avec ton idée (TempusFugit).
mais j'ai un gros souci : c'est qu'il ferme à chaque fois mon fichier source ce qui est assez ennuyeux car ma macro ne peut plus fonctionner et ne peut donc plus creer d'onglets autant qu'il existe de valeurs uniques dans la colonne B.

merci si vous pouvez m'éclaircir sur ce point...

Merci pour votre aide,


Sub Decouper()
Dim Rg As Range
Dim Wk As Workbook, Rg1 As Range
Dim Sh As Worksheet, Chemin As String
Dim nom As String

Worksheets("Extraction").Select
Set Sh = ActiveSheet
With Sh
Set Rg = .Range("A1:Z" & .Range("A65536").End(xlUp).Row)
End With

Do
With Rg
Workbooks("fichier extraction.xlsm").Activate
Worksheets("Extraction").Select
'Trier par ordre croissant

.Sort Key1:=Rg(2, 2), Header:=xlYes
'Filtre automatique
.AutoFilter Field:=2, Criteria1:=Rg(2, 2)
Workbooks("fichier extraction.xlsm").Activate
Worksheets("Extraction").Select

Set Rg1 = Sh.Range("_FilterDataBase")
.SpecialCells (xlCellTypeVisible)
.SpecialCells(xlCellTypeVisible).Select

Selection.Copy
Worksheets.Add

ActiveSheet.PasteSpecial
ActiveSheet.Name = Worksheets("Extraction").Range("B2").Value
Worksheets("Feuil2").Delete
nom = ".xlsm"
'Ajoute le code agence en début du nom du fichier
A = Rg(2, 2).Value

ActiveWorkbook.SaveCopyAs Filename:="O:\Controlling\Clot2012\FIRE\FC\9+4\" & A & nom

ActiveWorkbook.Close

'Definition du nom des fichiers créés
Application.DisplayAlerts = False
Rg1.Offset(1).Delete

Workbooks("fichier extraction.xlsm").Activate
Worksheets("Extraction").Select

End With

Loop Until Rg(2, 2) = ""
Application.EnableEvents = True
Application.DisplayAlerts = False
Application.DisplayAlerts = True
Set Wk = Nothing: Set Sh = Nothing

End Sub