Echec de la methode copy de la classe worksheet

Bonjour

je suis un peu embeté pour réaliser une copie de chaque feuille de mon classeur dans un dossier de sauvegarde placé dans mes documents.

le code suivant marche pourtant bien pour un faible nombre de feuilles à copier , mais dès que le nombre devient trop important

( 157 feuilles,) la macro plante ,avec le message "echec de la methode copy de la classe worksheet " , je suppose que cela doit etre du à un manque de memoire , j'en appel à votre savoir faire pour toute suggetion .

voici mon code :

Sub clone()

 Dim ws As Worksheet
Dim WbkD As Workbook
Dim NbFeuilles As Integer
    Dim fichier As String
    Dim nom As String
    Dim valeur As String
    Dim path As String
    valeur = "COMPTA_" & Format(Date, "ddmmyyyy") & "_" & Format(Time, "hhmmss") & ".xls"
    path = ActiveWorkbook.path & "\sauvegarde"

Application.ScreenUpdating = False

Workbooks("COMPTABILITE.xls").Unprotect Password:="sphinx"

  With ThisWorkbook
    For Each ws In .Sheets
      If ws.Name <> "mouvements comptables" Then
        If WbkD Is Nothing Then
          ws.Copy
          Set WbkD = ActiveWorkbook
        Else

          ws.Copy after:=WbkD.Sheets(WbkD.Sheets.Count)
          'Application.CutCopyMode = False
        End If
        ActiveSheet.DrawingObjects.Delete

      End If
    Next ws
  End With

  If Not WbkD Is Nothing Then
    With WbkD
      NbFeuilles = .Sheets.Count
      .SaveAs Filename:= _
"C:\Users\ROCKET\Documents\sauvegarde" & "\" & valeur
     .Close
    End With
  Else
    MsgBox "Plus de feuille à copier"
  End If
 With ThisWorkbook
Call purge_selective
Workbooks("COMPTABILITE.xls").Protect Password:="sphinx"
End With
End Sub

l'erreur se produit avec la ligne suivante :

ws.Copy after:=WbkD.Sheets(WbkD.Sheets.Count)

qui pourtant marche bien pour un faible nombres de copies

Merci pour toute indication ou idée .

Bonjour

Sujet à voir

https://forum.excel-pratique.com/excel/vba-probleme-avec-la-creation-de-feuilles-t27566.html

Bonjour Rocket 4 banzaî le forum,

bah pour moi je ne comprend pas pourquoi bêtement tu ne fais pas une activworkbook.savecopyas

là tu copies l’intégralité du classeur !!

Et après tu fais ta suppression des objets dans le nouveau classeur

a+

Papou

Bonjour

je vous rermercie pour vos réponses , merci à Paritec , j'ai fait en sorte .... finalement c'est en effet plus simple et plus de message

d'erreur , ...pourquoi faire compliqué