VBA copier une feuille et coller dans un nouveau classeur en valeurFermé

Question

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.

Patrice33740 · Answer

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
 
 
Cordialement
Patrice

Personne ne peut détenir tout le savoir, c'est pour ça qu'on le partage.

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

1 réponse

Newsletters