XL 2016 Fonction GetSaveAsFilename pour enregistrer une extraction

  • Initiateur de la discussion Initiateur de la discussion YANNISE
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

YANNISE

XLDnaute Junior
Bonjour le Forum,

Je voulais extraire les résultats de tableau filtre dans un nouveau classeur Excel avec la fonction GetSaveAsFilename mais j’obtiens aucun résultat ???

Pourriez-vous m'aider SVP, ci-après le code ainsi que le fichier

Sub Save_Doc()

Dim Plage
Dim MonClasseur As Workbook

Application.EnableEvents = False
Application.ScreenUpdating = False


Plage = ListeFichier = Application.GetSaveAsFilename(fileFilter:="Fichiers Excel (*.xls*),*xls*", Title:="Fichier ERP à Importer", ButtonText:="Importer")

If Plage <> False Then
With Feuil1
Set Plage = .Range("B2").CurrentRegion
Set MonClasseur = Workbooks.Add


Plage.SpecialCells(xlCellTypeVisible).Copy ActiveWorkbook.ActiveSheet.Range("A1")
Application.DisplayAlerts = False

Range("A1").Select
ActiveCell.CurrentRegion.EntireColumn.AutoFit




ActiveWorkbook.Close , False

End With
Application.EnableEvents = True

End If

MsgBox "Extraction faite"

End Sub
 

Pièces jointes

Solution
Petite corrections faites sur la macro précédente.
Je n'avais pas remarqué que l'on pouvait aller en bug.
Bruno
VB:
Sub Save_Doc()
Dim rep
 Set Plage = Feuil1.Range("B2").CurrentRegion
     Plage.SpecialCells(xlCellTypeVisible).Copy
 Set NewFich = Workbooks.Add
     ActiveWorkbook.ActiveSheet.Range("A1").PasteSpecial
     ActiveSheet.Range("A1").CurrentRegion.EntireColumn.AutoFit
rep = Application.GetSaveAsFilename(fileFilter:="Fichiers Excel (*.xls*),*xls*", Title:="Fichier ERP à Importer", ButtonText:="Importer")
If rep = False Then MsgBox "ANNULATION": ActiveWorkbook.Close (False): Exit Sub
  If rep Like ".xls" = False Then rep = rep & ".xls"
   NewFich.SaveAs Filename:=rep
    ActiveWorkbook.Close (False)
MsgBox "Extraction faite"...
Bonjour Yannise,
Voici un code modifié
Bruno
VB:
Sub Save_Doc()
Dim rep
    Set Plage = Feuil1.Range("B2").CurrentRegion
        Plage.SpecialCells(xlCellTypeVisible).Copy
    Set NewFich = Workbooks.Add
        ActiveWorkbook.ActiveSheet.Range("A1").PasteSpecial
        ActiveSheet.Range("A1").CurrentRegion.EntireColumn.AutoFit
rep = Application.GetSaveAsFilename(fileFilter:="Fichiers Excel (*.xls*),*xls*", Title:="Fichier ERP à Importer", ButtonText:="Importer")
  If rep = "" Then MsgBox "ANNULATION": Exit Sub
  NewFich.SaveAs Filename:=rep
        ActiveWorkbook.Close , False
MsgBox "Extraction faite"
End Sub
 
Petite corrections faites sur la macro précédente.
Je n'avais pas remarqué que l'on pouvait aller en bug.
Bruno
VB:
Sub Save_Doc()
Dim rep
 Set Plage = Feuil1.Range("B2").CurrentRegion
     Plage.SpecialCells(xlCellTypeVisible).Copy
 Set NewFich = Workbooks.Add
     ActiveWorkbook.ActiveSheet.Range("A1").PasteSpecial
     ActiveSheet.Range("A1").CurrentRegion.EntireColumn.AutoFit
rep = Application.GetSaveAsFilename(fileFilter:="Fichiers Excel (*.xls*),*xls*", Title:="Fichier ERP à Importer", ButtonText:="Importer")
If rep = False Then MsgBox "ANNULATION": ActiveWorkbook.Close (False): Exit Sub
  If rep Like ".xls" = False Then rep = rep & ".xls"
   NewFich.SaveAs Filename:=rep
    ActiveWorkbook.Close (False)
MsgBox "Extraction faite"
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
235
Réponses
22
Affichages
3 K
Réponses
6
Affichages
830
Retour