Exporter trois feuilles dans un nouveau fichier Excel

Bonjour à tous,

Je me permet de vous solliciter car je fais face à une impasse.
En effet, j'ai un fichier excel avec 7 feuilles et j'aimerais exporter seulement les trois premières dans un nouveau fichier excel: Listing_PDV; PDV AGGLO et Portrait de territoire. Grace à un code VBA j'ai réussi à obtenir que cela me créer un nouveau fichier, me demande de le nommer et cela m'exporte les deux premières. Cependant petit couac pour la feuille portrait de territoire, elle ne s'exporte pas et je ne comprend pas pourquoi. Peut-être car elle contient des tableaux ? une image ?

Voici le code que j'ai proposé :

Sub ExporterFeuilles()
Dim wb As Workbook
Dim newWb As Workbook
Dim ws As Worksheet
Dim newWs As Worksheet
Dim newName As String
Dim rng As Range
Dim destCell As Range
Dim srcCell As Range
Dim blockSize As Long
Dim rowCount As Long
Dim colCount As Long
Dim i As Long, j As Long

' Définir la taille du bloc de copie
blockSize = 1000 ' Vous pouvez ajuster cette valeur en fonction de la taille de vos données

' Activer le classeur contenant les données
Set wb = ThisWorkbook

' Créer un nouveau classeur
Set newWb = Workbooks.Add

' Demander à l'utilisateur de donner un nom au nouveau classeur
newName = InputBox("Entrez le nom du nouveau fichier:")

' Copier et coller les données des trois premières feuilles
For Each ws In wb.Worksheets
If ws.Name = "Listing_PDV" Or ws.Name = "PDV AGGLO" Or ws.Name = "Portrait de territoire" Then
ws.Copy After:=newWb.Sheets(newWb.Sheets.Count)
Set newWs = newWb.Sheets(newWb.Sheets.Count)
newWs.Name = ws.Name

' Déterminer la plage de données
rowCount = ws.UsedRange.Rows.Count
colCount = ws.UsedRange.Columns.Count

' Copier les données par blocs
Set destCell = newWs.Cells(1, 1)
For i = 1 To rowCount Step blockSize
For j = 1 To colCount Step blockSize
Set rng = ws.Range(ws.Cells(i, j), ws.Cells(Application.Min(i + blockSize - 1, rowCount), Application.Min(j + blockSize - 1, colCount)))
rng.Copy
destCell.PasteSpecial Paste:=xlPasteValues
Set destCell = destCell.Offset(rng.Rows.Count, 0)
Next j
Next i

' Supprimer les images de la feuille "Portrait de territoire" si elles existent
If ws.Name = "Portrait de territoire" Then
For Each shp In ws.Shapes
shp.Copy
newWs.Paste
Next shp
End If
End If
Next ws

' Supprimer la feuille de calcul par défaut dans le nouveau classeur
Application.DisplayAlerts = False
newWb.Sheets(1).Delete
Application.DisplayAlerts = True

' Sauvegarder le nouveau classeur avec le nom fourni par l'utilisateur
newWb.SaveAs Filename:=newName
End Sub

J'aimerais ainsi résoudre ce problème pour pouvoir par la suite créer un bouton qui me permettrait de créer un nouveau fichier excel, me demander de le nommer et exporter les trois premières feuilles correctement.

Je vous met le fichier en question;

En espérant que l'un de vous pourra m'aider et merci par avance.

Bonne journée :)

Windows / Edge 124.0.0.0