Besoin d'intégrer un copiage spéciale dans une vba

Bonjour,

Je fearis ceci :

Option Explicit
Sub Export_Récap_PrestaM3()
Dim wshSrc As Worksheet, wshDst As Worksheet
Dim rngSrc As Range

  Set wshSrc = Worksheets("Feuil1")             ' nom de feuille à adapter
  Set rngSrc = wshSrc.Range("BC4:BG37")         ' plage à copier à adapter
  Set wshDst = Application.Workbooks.Add(xlWBATWorksheet).Worksheets(1)
  With wshDst
    rngSrc.Copy .Range("A1")                    ' cellule de destination à adapter
    .Range("A1").Resize(rngSrc.Rows.Count, rngSrc.Columns.Count).Value = rngSrc.Value
    .Columns.AutoFit
    Application.PrintCommunication = False
    With .PageSetup
      .PaperSize = xlPaperA4: .Orientation = xlPortrait
      .RightFooter = "&P/&N"
      .CenterHorizontally = True: .Zoom = False
      .FitToPagesWide = 1: .FitToPagesTall = 1
    End With
    Application.PrintCommunication = True
    .PrintPreview
  End With
  ' Penser à sauvegarger l'export :
  ' wshDst.Parent.SaveAs "C:\Chemin complet\Nom du Fichier.xlsx"

End Sub 

i.e : copier tout, puis les valeurs.

Bonjour Patrice,

Merci pour votre aide.

J'ai tenter votre code et ça beug car j'avais indiquer qu'une seule partie pensant qu'il n'y aurait pas de modification des variables.
Résultat, quand j'utilise votre code j'ai un bug concernant le file name.

Je vous remet donc le code en entier afin de prendre en compte la partie sauvegarde :

Sub Export_Récap_PrestaM()

    Dim WsScr As Worksheet, WsDest As Worksheet, MaPlage As Range

    Set WsScr = Worksheets(ActiveSheet.Name) ' a adapter a vos besoins
    Set MaPlage = WsScr.Range("BC4:BG37")

    Application.SheetsInNewWorkbook = 1
    Application.Workbooks.Add

    Set WsDest = Worksheets(ActiveSheet.Name)
    MaPlage.Copy WsDest.Range("A1")
    With WsDest
    .Columns("A:E").AutoFit
        Application.PrintCommunication = False
        With .PageSetup
            .PaperSize = xlPaperA4:         .Orientation = xlPortrait
            .RightFooter = "&P/&N"
            .CenterHorizontally = True:     .Zoom = False
            .FitToPagesWide = 1:            .FitToPagesTall = 1
        End With
        Application.PrintCommunication = True
        .PrintPreview
    End With
    Filename = "C:\Users\linda\Documents\COLIS LOIRE EXPRESS\Gestion Clients\Factures\AnnexeFactures\Annexe_2_Facture_" & _
        Range("A1")
       
    On Error Resume Next
        ActiveWorkbook.SaveAs Filename:=Filename
        If Err > 0 Then
            Filename = Application.GetSaveAsFilename( _
                FileFilter:="Excel (*.xlsx),*.xlsx", _
                InitialFileName:=Filename)
       
            If Filename <> False _
            Then ActiveWorkbook.SaveAs Filename:=Filename
        End If
    On Error GoTo 0
   
    If ActiveWorkbook.Saved Then ActiveWorkbook.Close
       
    ' Libérer mémoire -------------------------------------------------
    Set WsScr = Nothing: Set WsDest = Nothing: Set MaPlage = Nothing
End Sub

Merci pour votre aide.

Cdt

Bonjour,

J'ai répondu hier mais curieusement ma réponse a disparu, la voici :

C'est une très mauvaise méthode de mettre le chemin "en dur", il est nettement préférable de travailler avec un chemin relatif. Penses à adapter le nom de la feuille, évites Activesheet.Name : de façon générale il faut éviter d'utiliser les objets actifs (Activesheet, Activeworkbook, Selection, ...) :

Option Explicit
Sub Export_Récap_PrestaM()
Dim wshSrc As Worksheet, wshDst As Worksheet
Dim rngSrc As Range
Dim nomDst As Variant

  Set wshSrc = Worksheets("Feuil1")             ' nom de feuille à adapter
  Set rngSrc = wshSrc.Range("BC4:BG37")         ' plage à copier à adapter
  ' Création Export
  Set wshDst = Application.Workbooks.Add(xlWBATWorksheet).Worksheets(1)
  With wshDst
    rngSrc.Copy .Range("A1")                    ' cellule de destination à adapter
    .Range("A1").Resize(rngSrc.Rows.Count, rngSrc.Columns.Count).Value = rngSrc.Value
    .Columns.AutoFit
    Application.PrintCommunication = False
    With .PageSetup
      .PaperSize = xlPaperA4: .Orientation = xlPortrait
      .RightFooter = "&P/&N"
      .CenterHorizontally = True: .Zoom = False
      .FitToPagesWide = 1: .FitToPagesTall = 1
    End With
    Application.PrintCommunication = True
    .PrintPreview
  End With
  ' Sauvegarde Export
   nomDst = "C:\Users\linda\Documents\COLIS LOIRE EXPRESS\Gestion Clients\Factures\AnnexeFactures\Annexe_2_Facture_" & Range("A1")
  ' NOTE : c'est une très mauvaise méthode de mettre le chemin "en dur", il est nettement préférable
  ' de travailler avec un chemin relatif à celui du fichier qui contient la macro, par exemple si le
  ' fichier est dans C:\Users\linda\Documents\COLIS LOIRE EXPRESS\Gestion Clients\Factures, écrire :
  ' nomDst = ThisWorkbook.Path & "\AnnexeFactures\Annexe_2_Facture_" & Range("A1")
  On Error Resume Next
  wshDst.Parent.SaveAs nomDst
  If Err > 0 Then
    nomDst = Application.GetSaveAsFilename(FileFilter:="Excel (*.xlsx),*.xlsx", InitialFileName:=nomDst)
    If nomDst <> False Then wshDst.Parent.SaveAs nomDst
  End If
  If wshDst.Parent.Saved Then wshDst.Parent.Close
  On Error GoTo 0

End Sub

Merci Patrice. cela semble bien fonctionner.

J'ai mis Set wshSrc = Worksheets(ActiveSheet.Name)

Merci également pour le conseil de la sauvegarde mais j'aimerais comprendre pourquoi penses--tu que c'est une mauvaise méthode? quels seraient les risques?

Avec l'utilisation de nomDst = ThisWorkbook.Path & "\COLIS LOIRE EXPRESS\Gestion Clients\Factures\AnnexeFactures\Annexe 2 - Récap Presta Mensuelle - Facture_" & Range("D1") le chemin proposer de sauvegarde est C:\Users\linda\Documents

Alors que je veux qu'il soit automatiquement enregistrer sous :
C:\Users\linda\Documents\COLIS LOIRE EXPRESS\Gestion Clients\Factures\AnnexeFactures sous le nom "Annexe 2 - Récap Presta Mensuelle - Facture_" & Range("D1")"

Pour info, le fichier de départ se trouve :
C:\Users\linda\Documents\COLIS LOIRE EXPRESS\Gestion Clients\Tableau de bord
Et l'export doit être dans :
C:\Users\linda\Documents\COLIS LOIRE EXPRESS\Gestion Clients\Factures

Merci encore pour ton aide
Cdt
Linda

Merci Patrick, mais cela ne fonctionne pas.

En revanche, la méthode qui me convient et qui fonctionne est celle ci :

Option Explicit
Sub Export_Récap_PrestaM()
Dim wshSrc As Worksheet, wshDst As Worksheet
Dim rngSrc As Range
Dim nomDst As Variant

  Set wshSrc = Worksheets(ActiveSheet.Name)             ' nom de feuille à adapter
  Set rngSrc = wshSrc.Range("BC4:BG39")         ' plage à copier à adapter
  ' Création Export
  Set wshDst = Application.Workbooks.Add(xlWBATWorksheet).Worksheets(1)
  With wshDst
    rngSrc.Copy .Range("A1")                    ' cellule de destination à adapter
    .Range("A1").Resize(rngSrc.Rows.Count, rngSrc.Columns.Count).Value = rngSrc.Value
    .Columns.AutoFit
    Application.PrintCommunication = False
    With .PageSetup
      .PaperSize = xlPaperA4: .Orientation = xlPortrait
      .RightFooter = "&P/&N"
      .CenterHorizontally = True: .Zoom = False
      .FitToPagesWide = 1: .FitToPagesTall = 1
    End With
    Application.PrintCommunication = True
    .PrintPreview
  End With
  ' Sauvegarde Export
   nomDst = "C:\Users\linda\Documents\COLIS LOIRE EXPRESS\Gestion Clients\Factures" & "\AnnexeFactures\Annexe 2 - Récap Presta Mensuelle - Facture_" & Range("D1")
  ' NOTE : c'est une très mauvaise méthode de mettre le chemin "en dur", il est nettement préférable
  ' de travailler avec un chemin relatif à celui du fichier qui contient la macro, par exemple si le
  ' fichier est dans C:\Users\linda\Documents\COLIS LOIRE EXPRESS\Gestion Clients\Factures, écrire :
  ' nomDst = ThisWorkbook.Path & "\AnnexeFactures\Annexe_2_Facture_" & Range("A1")
  On Error Resume Next
  wshDst.Parent.SaveAs nomDst
  If Err > 0 Then
    nomDst = Application.GetSaveAsFilename(FileFilter:="Excel (*.xlsx),*.xlsx", InitialFileName:=nomDst)
    If nomDst <> False Then wshDst.Parent.SaveAs nomDst
  End If
  If wshDst.Parent.Saved Then wshDst.Parent.Close
  On Error GoTo 0

End Sub

Merci beaucoup en tout cas.
Au plaisir de vous lire à nouveau

Cdt

Bonsoir Patrick,

J'ai modifié l'erreur que je n'avais pas vu. Le fichier s'enregistre bien à l'endroit souhaité par contre sans récupérer le texte de D1.
Le fichier est donc enregistrer sous le nom "Annexe 2 - Récap Presta Mensuelle - Facture_" ce qui pose problème si je veux enregistrer d'autre fichier de mois différents.

Cdt