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

Résolu/Fermé

LinDouch42 - 20 nov. 2020 à 23:03
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 - 23 nov. 2020 à 21:14

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

A voir également:

Besoin d'intégrer un copiage spéciale dans une vba
Comment intégrer une vidéo dans un powerpoint - Guide
Incompatibilité de type vba ✓ - Forum Programmation
Symbole lettre spéciale - Guide
Erreur 1004 vba ✓ - Forum VB / VBA
Vba attendre 1 seconde ✓ - Forum VB / VBA

6 réponses

Réponse 1 / 6

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 778
Modifié le 21 nov. 2020 à 11:49

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.

Réponse 2 / 6

LinDouch42
22 nov. 2020 à 10:18

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

Réponse 3 / 6

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 778
Modifié le 23 nov. 2020 à 09:23

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

Réponse 4 / 6

LinDouch42
23 nov. 2020 à 10:07

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

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 778
23 nov. 2020 à 13:47

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

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 6

LinDouch42
23 nov. 2020 à 14:12

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

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 778
Modifié le 23 nov. 2020 à 15:52

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 ?

Réponse 6 / 6

LinDouch42
23 nov. 2020 à 20:29

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

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 778
23 nov. 2020 à 20:54

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à !

LinDouch42 > Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023
23 nov. 2020 à 21:07

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

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 778 > LinDouch42
23 nov. 2020 à 21:14

ou bien wshDst.Range("D1")

Discussions similaires

"L'indice n'appartient à la sélection" + VBA

[EXCEL] - VBA - Ecrire dans un cellule

ouverture d'un fichier excel à partir d'un code VBA

VBA : Range avec références variables..

Méthode find dans VBA - Recherche de données sous Excel

Discussions similaires

Newsletters