VBA copier une feuille et coller dans un nouveau classeur en valeur

Fermé
Mathieu - Modifié le 1 avril 2020 à 15:59
 Mathieu - 2 avril 2020 à 09:16
Bonjour,

Je souhaite créer une macro qui permet de copier la 44ème feuille d'un classeur et la coller en valeur dans un nouveau classeur.

Lorsque je lance la macro ci-dessous, j'ai une erreur d’exécution '1004' "Cette opération requiert que les cellules fusionnées soient de taille identique" sur "xlPasteValues".

Sub MAPA()

Dim feuille, nom, Export
Set feuille = ActiveWorkbook.Sheets(44)
nom = "DQE_MAPA_Terrassement" & ".xlsx"

Application.Workbooks.Add
Export = ActiveWorkbook.Name
feuille.Cells.Copy

With Workbooks(Export).Sheets(1).Cells
Selection.PasteSpecial Paste:=xlPasteAll
Selection.PasteSpecial Paste:=xlPasteValues
End With
Workbooks(Export).SaveAs Range("DQE_MAPA_Terrassement.xlsx")

Application.CutCopyMode = False

End Sub

Je ne comprends pas pourquoi.

Je vous remercie par avance pour votre aide.

Mathieu.

1 réponse

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 779
Modifié le 1 avril 2020 à 17:17
Bonjour,

Comme ça :
Option Explicit
Sub MAPA()
Dim c As Workbook
Dim f As Worksheet
Dim r As Range
Dim t As Variant
Dim nom As String
  
  Set f = ActiveWorkbook.Worksheets(44)
  Set c = Application.Workbooks.Add(xlWBATWorksheet)
  Set r = c.Worksheets(1).Range("A1")
  nom = ThisWorkbook.Path & "\DQE_MAPA_Terrassement.xlsx"
  t = f.UsedRange.Value
  r.Resize(UBound(t, 1), UBound(t, 2)).Value = t
  c.SaveAs nom
  c.Close

End Sub

EDIT : Et si tu veux aussi les formats :
Option Explicit
Sub MAPA()
Dim c As Workbook
Dim f As Worksheet
Dim r As Range
Dim t As Variant
Dim nom As String
  
  Set f = ActiveWorkbook.Worksheets(44)
  Set c = Application.Workbooks.Add(xlWBATWorksheet)
  Set r = c.Worksheets(1).Range("A1")
  nom = ThisWorkbook.Path & "\DQE_MAPA_Terrassement.xlsx"
  f.UsedRange.Copy r
  t = f.UsedRange.Value
  r.Resize(UBound(t, 1), UBound(t, 2)).Value = t
  c.SaveAs nom
  c.Close

End Sub



0
Merci, c'est parfait !

Cordialement.
0