Exportation feuille Excel

Bonjour,

Je vous sollicite pour un petit coup de pouce...

Je tente de construire une macro qui exporte la feuille active dans un nouveau classeur.

Mais Je ne voudrais pas copier la feuille entière mais simplement une plage de cellule ("A1:AF55") et j'aimerais que le classeur s'enregistre automatiquement sur le bureau. Pour le moment j'en suis la :

Sub Exportation()
On Error Resume Next
 Dim objWorkbookCible As Workbook
 Dim objworkbooksource As Workbook
Application.DisplayAlerts = False
    ActiveSheet.Copy 
  Set objWorkbookCible = ActiveWorkbook
  ActiveWorkbook.SaveAs ActiveSheet.Name
    ActiveWorkbook.Close True 'ferme
    Application.DisplayAlerts = True
End Sub

bonjour

un essai : pour l'enregistrement sur le bureau :

remplace cette ligne :

  ActiveWorkbook.SaveAs ActiveSheet.Name

par

 ActiveWorkbook.SaveAs Environ("USERPROFILE") & "\desktop\" & ActiveSheet.Name

pour copier seulement une plage :

creation d'une feuille temporaire

copie de la zone

et faire ta procédure d'export de la feuille dans un nouveau fichier

supprimer la feuille temporaire

fred

aller comme je suis gentil... vois le code en entier

attention a l’instruction on

error resume next

... que je n'utilise personnellement que très peu... car source d'erreur de fonctionnement

fred

Sub test()
Dim shd As Worksheet
Dim shs As Worksheet
Set shs = ActiveSheet
Dim objWorkbookCible As Workbook

Sheets.Add after:=Sheets(Sheets.Count)
Set shd = ActiveSheet
shs.Range("A1:AF55").Copy shd.[A1]

Application.DisplayAlerts = False
shd.Copy
Set objWorkbookCible = ActiveWorkbook
objWorkbookCible.SaveAs shs.Name
objWorkbookCible.Close True 'ferme
shd.Delete
Application.DisplayAlerts = True
End Sub

Bonjour,

Une piste avec commentaires dans le code :

Sub Test()

    Dim Cls As Workbook
    Dim Fe As Worksheet
    Dim Tbl
    Dim WS As Object
    Dim Chemin As String

    ActiveSheet.Copy 'création du classeur car pas de destination

    Set Cls = ActiveWorkbook
    Set Fe = Cls.Worksheets(1) 'il y a une seule feuille dans le classeur

    Tbl = Fe.Range("A1:AF55") 'affecte la plage au tableau typé Variant
    Fe.Cells.Clear 'supprime toutes les valeurs
    Fe.Range("A1:AF55").Value = Tbl 'puis colle celles du tableau

    Set WS = CreateObject("WScript.Shell")
    Chemin = WS.SpecialFolders("Desktop") & "\" 'récup du chemin du bureau

    Cls.SaveAs Chemin & Fe.Name 'enregistre par défaut en .xlsx
    Cls.Close True, ferme

End Sub

fred2406 a écrit :

aller comme je suis gentil... vois le code en entier

attention a l’instruction on

error resume next

... que je n'utilise personnellement que très peu... car source d'erreur de fonctionnement

fred

Sub test()
Dim shd As Worksheet
Dim shs As Worksheet
Set shs = ActiveSheet
Dim objWorkbookCible As Workbook

Sheets.Add after:=Sheets(Sheets.Count)
Set shd = ActiveSheet
shs.Range("A1:AF55").Copy shd.[A1]

Application.DisplayAlerts = False
shd.Copy
Set objWorkbookCible = ActiveWorkbook
objWorkbookCible.SaveAs shs.Name
objWorkbookCible.Close True 'ferme
shd.Delete
Application.DisplayAlerts = True
End Sub

Merci pour votre aide Fred

[quote=Theze post_id=622368 time=1518509136 user_id=12964]

Bonjour,

Une piste avec commentaires dans le code :

[code]

Sub Test()

Dim Cls As Workbook

Dim Fe As Worksheet

Dim Tbl

Dim WS As Object

Dim Chemin As String

ActiveSheet.Copy 'création du classeur car pas de destination

Set Cls = ActiveWorkbook

Set Fe = Cls.Worksheets(1) 'il y a une seule feuille dans le classeur

Tbl = Fe.Range("A1:AF55") 'affecte la plage au tableau typé Variant

Fe.Cells.Clear 'supprime toutes les valeurs

Fe.Range("A1:AF55").Value = Tbl 'puis colle celles du tableau

Set WS = CreateObject("WScript.Shell")

Chemin = WS.SpecialFolders("Desktop") & "\" 'récup du chemin du bureau

Cls.SaveAs Chemin & Fe.Name 'enregistre par défaut en .xlsx

Cls.Close True, ferme

End Sub

Merci Theze pour votre aide :)

J'ai réussi à bidouiller...

Voici une proposition:

Sub Exportation()

Dim Destination As String
Dim shd As Worksheet
Dim shs As Worksheet
Set shs = ActiveSheet

Destination = "C:\Users\Alex\Desktop\"
Destination = "C:\Users\Filemaker\Desktop\"

On Error Resume Next
 Dim objWorkbookCible As Workbook
 Dim objworkbooksource As Workbook
Application.DisplayAlerts = False
    ActiveSheet.Copy
  Set objWorkbookCible = ActiveWorkbook
   ActiveWorkbook.SaveAs Destination & ActiveSheet.Name
   ActiveSheet.Shapes("Text Box 12").Delete
   ActiveSheet.Shapes("Text Box 16").Delete
   ActiveSheet.Shapes("Text Box 13").Delete
   ActiveSheet.Shapes("Text Box 14").Delete
   ActiveSheet.Shapes("Text Box 15").Delete
   ActiveSheet.Shapes("Text Box 17").Delete
    ActiveWorkbook.Close True 'ferme
    Application.DisplayAlerts = True
End Sub

Un grand merci Teze et Fred pour votre aide