Copie d'une feuille de classeur par macro

[DAVIDRUN]

Salut le forum,
Je souhaiterai savoir comment créer une copie
d' une feuille SEULE d'un classeur donné et tout cela par macro, cette copie devra être enregistrée dans un dossier "machinchose" existant ou non et dans le même repertoire que mon classeur actif.


Merci pour vos conseils.

Bye
DAVIDRUN

 

[Evelynetfrancois]

pense a l'enregistreur de macro
EtF

 

[Jhocquevelt]

Voici une routine qui permet de copier la feuille active dans un classeur se trouvant dans le même répertoire.

Sub CopyFeuille()
Dim wbk As Workbook
Dim wbk1 As Workbook
Dim sht As Worksheet
Dim FichierMachinChose As String
Dim FichierExiste As Boolean
Dim FichierDejaOuvert As Boolean

Set wbk = ActiveWorkbook
Set sht = ActiveSheet
FichierMachinChose = "machinchose.xls"

For Each wbk1 In Workbooks
If wbk1.Name = FichierMachinChose Then
FichierDejaOuvert = True
Exit For
End If
Next wbk1
If FichierDejaOuvert Then
Set wbk1 = Workbooks(FichierMachinChose)
Else
'Test pour savoir si le fichier existe
If Dir(wbk.Path & "\" & FichierMachinChose) = FichierMachinChose Then
' Ouverture du Fichier
FichierExiste = True
FichierMachinChose = wbk.Path & "\" & FichierMachinChose
Workbooks.Open Filename:=FichierMachinChose
Set wbk1 = ActiveWorkbook
Else
' Création du Fichier
Set wbk1 = Workbooks.Add
End If
End If
'Copy de la feuille active dans le classeur
wbk.Activate
sht.Select
sht.Copy Before:=wbk1.Sheets(1)
If FichierDejaOuvert Then
' Enregistrement du fichier sans le fermer
wbk1.Save
Else
If FichierExiste Then
'Fermeture et enregistrement du fichier
wbk1.Close SaveChanges:=True
Else
' Enregistrement puis fermeture du fichier créé
wbk1.SaveAs Filename:=FichierMachinChose, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
wbk1.Close
End If
End If
' Activation du classeur d'origine
wbk.Activate

End Sub

 

[DAVIDRUN]

Merci pour ta routine Jhocquevelt ;
en l'adaptant un peu j'obtient ce que je souhaites.

SALUT

DAVIDRUN