Copier onglet dans un classeur existant dans un nouvel onglet

Bonjour la communauté,

Après quelque recherche, j'ai trouvé un code VBA qui correspond à mon besoin, mais pas totalement.

J'arrive à copier l'onglet dans le classeur existant en créant un nouvel onglet, mais je n'arrive pas à nommer ce nouvel onglet avec les données de 2 cellules

Sub Transfére()

Dim chemin As String, nomfichier As String
Dim Fdest As String
Dim w1 As Workbook
Dim w2 As Workbook

'mise en mémoire du nom du fichier actif
Set w1 = ActiveWorkbook
'chemin a adapter
chemin = "E:\Travail\Export\"
'Sheets= le nom de la feuille a sauvegarder, Range= la cellule a copier comme nom de fichier
nomfichier = Sheets("colisage").Range("D5").Value & "_" & Range("D4").Value 
'nom du fichier destination
Fdest = "Export.xlsx"
'verification de l'existence du fichier de destination
If Dir(chemin & Fdest) <> "" Then
    'ouverture du fichier destination
  Workbooks.Open (chemin & Fdest)
  Set w2 = ActiveWorkbook
    'copie de l'onglet
  w1.ActiveSheet.Copy after:=w2.Sheets(Sheets.Count)
    'fermeture du fichier destination avec enregistremeent
  w2.Close True
Else
 MsgBox ("fichier de destination non trouvé")
End If
End Sub

Merci de votre aide

Bonjour

Essayez comme ceci

Sub Transfere()

Dim chemin As String, nomfichier As String
Dim Fdest As String
Dim w1 As Workbook, w2 As Workbook

'mise en mémoire du nom du fichier actif
Set w1 = ThisWorkbook
'chemin a adapter
chemin = "E:\Travail\Export\"
'Sheets= le nom de la feuille a sauvegarder, Range= la cellule a copier comme nom de fichier
nomfichier = Sheets("colisage").Range("D5").Value & "_" & Range("D4").Value
'nom du fichier destination
Fdest = "Export.xlsx"
'verification de l'existence du fichier de destination
If Dir(chemin & Fdest) <> "" Then
    'ouverture du fichier destination
  Workbooks.Open (chemin & Fdest)
  Set w2 = Workbooks(Fdest)
    'copie de l'onglet
  w1.ActiveSheet.Copy after:=w2.Sheets(Sheets.Count)
  w2.ActiveSheet.Name = nomfichier
    'fermeture du fichier destination avec enregistremeent
  w2.Close True
Else
 MsgBox ("fichier de destination non trouvé")
End If
End Sub

Cordialement

Bonjour Dan,

Pile poil se que je souhaitais.

Merci.