Export feuille ado

Function RépertoireExiste(Chemin As String) As Boolean
 Application.ScreenUpdating = False
On Error Resume Next
RépertoireExiste = GetAttr(Chemin) And vbDirectory
    If RépertoireExiste = True Then
        Exit Function
    Else
        MkDir (Chemin)
    End If
 
End Function

Function FeuilleExiste2( _
  wbk As Excel.Workbook, _
  ByVal strFeuille As String) As Boolean
  Dim strNom As String
  
  On Error Resume Next
  strNom = wbk.Sheets(strFeuille).Name
  FeuilleExiste2 = (Err.Number = 0)
End Function
Function FeuilleExiste( _
  wbk As Excel.Workbook, _
  ByVal strFeuille As String) As Boolean
  Dim Sht As Excel.Worksheet
  
  For Each Sht In wbk.Sheets
    If Sht.Name = strFeuille Then
      FeuilleExiste = True
      Exit Function
    End If
  Next
  
  FeuilleExiste = False
End Function
 Public Function FichierExiste(MonFichier As String)
'par Excel-Malin.com ( https://excel-malin.com/ )
 
   If Len(Dir(MonFichier)) > 0 Then
      FichierExiste = True
   Else
      FichierExiste = False
   End If
End Function

Sub Bouton36_Cliquer()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim InputFile As Workbook
Dim OutputFile As Workbook
Dim fissa As String
Dim Wb As Workbook
Dim ws As Worksheet
Dim yit As String
Set InputFile = ThisWorkbook
''''///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Call RépertoireExiste(ThisWorkbook.Path & "\BACKUP" & "\Planning\")

fissa = ThisWorkbook.Path & "\BACKUP" & "\Planning\" & Sheets("Plan").Range("E13").Value & ".xlsx"

If FichierExiste(fissa) = True Then
      'MsgBox "Le fichier FISSA existe..."
    Else
    'MsgBox "Le fichier FISSA n'existe pas..."
Workbooks.Add.SaveAs Filename:=ThisWorkbook.Path & "\BACKUP" & "\Planning\" & Sheets("Plan").Range("E13").Value & ".xlsx"
End If
Set OutputFile = Workbooks.Open(fissa)
InputFile.Activate
yit = Sheets("Plan").Range("E13").Value
'MsgBox yit
If FeuilleExiste(OutputFile, yit) Then
    'MsgBox "La feuille" & yit & "existe.", vbInformation
        OutputFile.Sheets(yit).Delete
        Set ws = OutputFile.Sheets.Add
ws.Name = yit
    Else
        'MsgBox "Feuille A introuvable !", vbExclamation
Set ws = OutputFile.Sheets.Add
ws.Name = yit
End If
OutputFile.Activate
ActiveWindow.DisplayGridlines = False
'Now, copy what you want from InputFile:
InputFile.Sheets("Plan").Activate

InputFile.Sheets("Plan").Range("$E$11:$AL$34").SpecialCells(xlCellTypeVisible).Copy
OutputFile.Sheets(yit).Range("E11").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
OutputFile.Sheets(yit).Range("E11").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
InputFile.Sheets("Plan").Shapes.Range(Array("Group 1")).Select
    Selection.Copy
   OutputFile.Sheets(yit).Paste Destination:=OutputFile.Sheets(yit).Range("A1")
    
   
Application.CutCopyMode = False
OutputFile.Activate
OutputFile.Sheets(yit).Range("a1").Select

OutputFile.Sheets(yit).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    OutputFile.Sheets(yit).EnableSelection = xlNoSelection
    
OutputFile.Close SaveChanges:=1
Application.ScreenUpdating = True
      MsgBox " Exporté"
End Sub