Bonjour,

J'ai fait une macro qui copie un tableau filtré sur mon fichier excel et qui le colle dans des slides PPT.
La macro fonctionne très bien mais dès qu'il y a des cellules fusionnées dans la dernière ligne mon tableau ça bug sur cette ligne de commande: rngCopie.Copy
Quelqu'un a une idée?
Merci !

Sub CopierFiltrerCollerImageVersPowerPoint()
Dim ws As Worksheet
Dim rngFiltre As Range
Dim rngCopie As Range
Dim pptApp As Object
Dim pptPres As Object
Dim pptSlide As Object
Dim chartObject As Object



' Référence à la feuille Excel
Set ws = ThisWorkbook.Sheets("Synthèse")

' Liste des valeurs à filtrer
filtreValues = Array("Env d'éxécution applicatif", "Identité", "Interconnexion réseau", "ITSM - Référentiels", "Observabilité", "Outillage", "Projet transverses", "Sauvegarde - Ordonnancement", "Services transverses", "Socle Datacenter", "Env d'éxécution système", "Plateforme Cloud")
' Créer une nouvelle instance PowerPoint
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = True ' Vous pouvez définir cette ligne sur False si vous ne voulez pas voir PowerPoint pendant le processus
' Créer une nouvelle présentation PowerPoint
Set pptPres = pptApp.Presentations.Add
' Itérer sur chaque valeur à filtrer
For Each filtreValue In filtreValues
' Appliquer le filtre sur la colonne B
ws.Range("B13").AutoFilter Field:=1, Criteria1:=filtreValue

' Trouver la plage filtrée dans la colonne B
On Error Resume Next
Set rngFiltre = ws.Range("B13:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
On Error GoTo 0

' Vérifier si des données ont été trouvées après le filtre
If Not rngFiltre Is Nothing Then
' Définir la plage à copier (colonnes E à AM, lignes 12 à la dernière ligne non vide après filtre)

Set rngCopie = ws.Range("E12:AM" & ws.Cells(ws.Rows.Count, "E").End(xlUp).Row + 1).SpecialCells(xlCellTypeVisible)


' Ajouter une nouvelle diapositive
Set pptSlide = pptPres.Slides.Add(1, 12) ' 12 correspond à la constante ppLayoutBlank

' Copier la plage dans le presse-papiers
rngCopie.Copy

' set the ViewType as normal before pasting.
pptApp.ActiveWindow.ViewType = ppViewNormal

' Coller l'image sur la diapositive PowerPoint
pptSlide.Shapes.PasteSpecial ppPasteEnhancedMetafile


' Ajuster la largeur de l'image à la largeur de la diapo
Dim shape As Object
Set shape = pptSlide.Shapes(pptSlide.Shapes.Count)
With shape
.LockAspectRatio = msoTrue
.Width = pptSlide.Master.Width ' Ajustez si nécessaire
' Ajuster la position verticale du shape
ShapeTop = (pptSlide.Master.Height - .Height) / 3 ' Au milieu de la diapositive
.Top = ShapeTop
End With
' Effacer le presse-papiers
Application.CutCopyMode = False

' Désactiver le filtre
'ws.AutoFilterMode = False
Else
MsgBox "Aucune donnée correspondante trouvée.", vbExclamation
End If
Next filtreValue
End Sub