Copier-coller une feuille avec nom identique entre deux classeurs ouverts

Sub mtv()

    Dim Wk As Workbook, Wk1 As Workbook
    Dim Classeur1 As String, Classeur2 As String
    Dim Flag1 As Boolean, Flag2 As Boolean
    Dim i As Integer, h As Integer
    
    'Les libellés entre les guillemets sont à changer
    Classeur1 = "Nom du classeur où je vais copier mes données.xlsx"
    Classeur2 = "Nom du classeur où se trouvent les données à copier.xlsx"
    
    Flag1 = False
    Flag2 = False
    
    
    For i = 1 To Application.Windows.Count
        
        If Workbooks(i).Name = Classeur1 Then Flag1 = True
        If Workbooks(i).Name = Classeur2 Then Flag2 = True
        
    Next i
    
    If Flag1 = False Or Flag2 = False Then
        
        MsgBox "Un des classeurs n'a pas de nom valide", vbCritical, "Attention"
        Exit Sub
        
    End If
    
    Set Wk = Workbooks(Classeur1)
    Set Wk1 = Workbooks(Classeur2)
    
    For i = 1 To Wk.Sheets.Count
    
        For h = 1 To Wk1.Sheets.Count
            
            If Wk1.Sheets(h).Name = Wk.Sheets(i).Name Then
            
                Wk1.Sheets(h).Cells.Copy Destination:=Wk.Sheets(i).Cells
                GoTo Borne
                
            End If

        Next h
        Chaine = Chaine & " / " & Wk.Sheets(i).Name
        
Borne:
    Next i
    
    If Chaine <> "" Then
        
        MsgBox "Les feuilles suivantes n'ont pas été trouvées: " & vbNewLine & Chaine, vbExclamation, "Attention"
    
    End If
    
    
End Sub

Option Explicit
Option Base 1
Option Compare Text


Dim i As Integer, h As Integer
Dim maPlage As Range
Dim Ws As Workbook


Sub Nettoyage()


    Application.ScreenUpdating = False
    
    Application.Dialogs(xlDialogFindFile).Show
    
    If ActiveWorkbook.Name = ThisWorkbook.Name Then Exit Sub
    
    For i = 1 To Sheets.Count
        
        With Sheets(i)
        
            Set maPlage = Sheets(i).Range("A42:BN2131")
            
            maPlage.ClearContents
            maPlage.ClearFormats
            
            For h = 1 To .Cells(1, 287).End(xlToLeft).Column
                
                If .Cells(1, h).Value Like "*Prof*" Then .Columns(h).Delete
            
            Next h
            
        End With
        
    Next i
    
    Application.ScreenUpdating = True
    
End Sub

Option Explicit
Option Base 1
Option Compare Text


Dim i As Integer, h As Integer
Dim maPlage As Range
Dim Ws As Workbook

Sub copie_fichier_prof()

ThisWorkbook.SaveCopyAs "C:\Users\User\Documents\Jonfosse\Horaires\profess eurs.xls"
'
Workbooks.Open "C:\Users\User\Documents\Jonfosse\Horaires\profess eurs.xls"
Workbooks("professeurs.xls").Activate

Application.DisplayAlerts = False
Sheets(Array("Gestion", "J_109", "Données")).Delete

Dim i As Integer, h As Integer
Dim maPlage As Range
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
With Sheets(i)
Set maPlage = Sheets(i).Range("A42:BN2131")
maPlage.ClearContents
maPlage.ClearFormats
For h = 1 To .Cells(1, 287).End(xlToLeft).Column
If .Cells(1, h).Value Like "*Prof*" Then .Columns(h).Delete
Next h


.Range("A1:AT40").Copy .Range("AV1:CO40")
.Range("CN:CN, CL:CL, CJ:CJ, CH:CH, CE:CE, CC:CC, CA:CA, BY:BY, BV:BV, BT:BT, BR:BR, BP:BP, BM:BM, BK:BK, BI:BI, BG:BG, BD:BD, BB:BB, AZ:AZ, AX:AX").Delete
.Range("AT:AT, AR:AR, AP:AP, AN:AN, AK:AK, AI:AI, AG:AG, AE:AE, AB:AB, Z:Z, X:X, V:V, S:S, Q:Q, O:O, M:M, J:J, H:H, F:F, D:D").Delete

End With
Next i
Application.ScreenUpdating = True

Workbooks("professeurs.xls").Close True
Application.DisplayAlerts = False

End Sub