XL 2016 Fonction GetSaveAsFilename pour enregistrer une extraction

YANNISE · 23 Mai 2022

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

youky(BJ) · 23 Mai 2022

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"...

youky(BJ) · 23 Mai 2022

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

youky(BJ) · 23 Mai 2022

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

YANNISE · 23 Mai 2022

Bonjour @youky(BJ) c'est parfait un grand merci a toi

XL 2016 Fonction GetSaveAsFilename pour enregistrer une extraction

YANNISE

XLDnaute Junior

Pièces jointes

youky(BJ)

youky(BJ)

XLDnaute Barbatruc

youky(BJ)

XLDnaute Barbatruc

YANNISE

XLDnaute Junior

Discussions similaires