Besoin d'aide sur une macro type "Copier/Coller"

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Transfert ActiveSheet.Name, Target.Row
End Sub

Option Explicit
Sub Transfert(Feuille As String, Ligne As Long)
'
'
Dim Chemin As String, DDV As String, PLANNING As String
Dim Nom As String, Autorise As String
Dim Pointeur As Long, Longueur As Long
Chemin = ThisWorkbook.Path & "\"
DDV = "DDV.xls"
PLANNING = "PLANNING.xls"
Autorise = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefjhijklmnopqrstuvwxyz_0123456789."

Workbooks.Open Chemin & DDV
With Workbooks(PLANNING).Sheets(Feuille)
   Workbooks(DDV).Sheets("Fiche vente").Range("B1").Value = .Range("B" & Ligne)
   Workbooks(DDV).Sheets("Fiche vente").Range("D1").Value = .Range("C" & Ligne)
   Workbooks(DDV).Sheets("Fiche vente").Range("A4").Value = .Range("D" & Ligne)
   Workbooks(DDV).Sheets("Fiche vente").Range("C5").Value = .Range("E" & Ligne)
   Workbooks(DDV).Sheets("Fiche vente").Range("E5").Value = .Range("F" & Ligne)
End With
   
    Nom = Workbooks(DDV).Sheets("Fiche vente").Range("B1") & ".xls"
    'si le document n'a jamais été enregistré
  If Workbooks(DDV).Path = "" Then
    'boîte de dialogue Enregistrer sous
    Application.GetSaveAsFilename Chemin & Nom, FileFilter:="Fichier Excel (*.xls), *.xls", Title:="Choisir un dossier"
   Else
    If Nom = "" Then
Reprise:
     Nom = InputBox("Entrez le nom du fichier ")
     Workbooks(DDV).Sheets("Fiche vente").Range ("B1") & ".xls" = Nom
    End If
     
    If MsgBox("Voulez-vous enregistrer le fichier sous le nom " & Nom & " ?", 4) = 6 Then
        If Dir(Chemin & Nom) <> "" And Nom <> "DDV.xls" Then Kill Chemin & Nom
        'Enregistre dans le même dossier

        Pointeur = 0
        Longueur = Len(Nom)
        Do
        Pointeur = Pointeur + 1
        If InStr(1, Autorise, Mid(Nom, Pointeur, 1)) = 0 Then
            MsgBox "Le nom proposé contient un caractère interdit : " & Mid(Nom, Pointeur, 1), 48
            GoTo Reprise
        End If
        Loop Until Pointeur = Longueur
        ActiveWorkbook.SaveAs Chemin & Nom
        End If

End If
Workbooks(Nom).Close False
End Sub