VBA Problème enregistrer sous

Sub Enregister()
Dim Lecteur$, Fichier$, Nom$, Num$, sDate$
Nom = Cells(8, 4).Value
Num = Format(Cells(6, 4), "000") & Cells(6, 5) & Cells(6, 6)
sDate = Format(CDate(Cells(39, 2)), "dd-MM-YYYY")
Fichier = Nom & " Facture " & Num & " du " & sDate
If Dir("J:\") <> "" Then
    Lecteur = "J:\"
    ActiveWorkbook.SaveAs Lecteur & Fichier & ".xlsm"
End If
End Sub

Sub Lecteurs()
Dim fs, dc, d, Texte$
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
For Each d In dc
    If d.DriveLetter <> "A" Then 'zappe disquette A
        If d.DriveType = 1 And d.IsReady Then
            Texte = Texte & "Lecteur : " & d.DriveLetter & _
                            vbCrLf & "Volume : " & d.VolumeName & vbCrLf
        End If
    End If
Next
MsgBox Texte
End Sub