Besoin d'intégrer un copiage spéciale dans une vba [Résolu]

Signaler
-
Messages postés
8268
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 novembre 2020
-
Bonjour,

J'ai besoin de rajouter dans cette vba le fait que je veuille uniquement une copie des valeurs et du format (tous sauf les formules).

Je sais que je dois utiliser
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats

Mais je ne sais pas ou les placer


Sub Export_Récap_PrestaM3()

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
MaPlage.Copy
.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


Merci pour votre aide

Cdt
Configuration: Windows / Chrome 86.0.4240.198

6 réponses

Messages postés
8268
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 novembre 2020
1 527
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.

Cordialement
Patrice

Personne ne peut détenir tout le savoir, c'est pour ça qu'on le partage.
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
Messages postés
8268
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 novembre 2020
1 527
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



Cordialement
Patrice

Personne ne peut détenir tout le savoir, c'est pour ça qu'on le partage.
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
Messages postés
8268
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 novembre 2020
1 527
Comme ça :
Option Explicit
Sub Export_Récap_PrestaM()
Dim wshSrc As Worksheet, wshDst As Worksheet
Dim rngSrc As Range
Dim nomDst As Variant
Dim chemin As String

  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
  chemin = ThisWorkbook.Path & "\..\Facturess\AnnexeFactures\"
  nomDst = "Annexe 2 - Récap Presta Mensuelle - Facture_" & wshSrc.Range("D1")
  On Error Resume Next
  wshDst.Parent.SaveAs chemin & nomDst
  If Err > 0 Then
    If Dir(chemin, vbDirectory) = "" Then chemin = ThisWorkbook.Path & "\..\"
    nomDst = Application.GetSaveAsFilename(FileFilter:="Excel (*.xlsx),*.xlsx", InitialFileName:=chemin & 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 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
Messages postés
8268
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 novembre 2020
1 527
J'ai oublié d'enlever un s en trop à Facturess dans :
chemin = ThisWorkbook.Path & "\..\Facturess\AnnexeFactures\"

à remplacer par
chemin = ThisWorkbook.Path & "\..\Factures\AnnexeFactures\"    

« ça fonctionne pas » ça veux dire quoi ? Il y a un message d'erreur ?
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
Messages postés
8268
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 novembre 2020
1 527
Tu n'a pas précisé la feuille, dans mon code j'ai précisé wshSrc.Range("D1") mais c'est peut-être pas celle là !
>
Messages postés
8268
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 novembre 2020

D'accord, donc le problème vient de là. Il récupère l'info D1 de la feuille "source" alors que moi je pensais à récupérer le range D1 de la feuille exporté. Ce n'est donc pas range D1 mais BH4, et après test cela fonctionne .

Un grand merci pour votre investissement et aide dans ce dossier.

A bientôt
Cdt
Messages postés
8268
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 novembre 2020
1 527 > LinDouch42
ou bien wshDst.Range("D1")