1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
| Sub ArchivesXLSM()
Dim chemin As String, Fichier As String, LeNom As String
LeNom = Range("C3").Value
On Error Resume Next
Existe1 = GetAttr(ThisWorkbook.Path & "\PREPA_SALAIRE\")
If Existe1 = "" Then
MkDir ThisWorkbook.Path & "\PREPA_SALAIRE\"
End If
On Error Resume Next
Existe2 = GetAttr(ThisWorkbook.Path & "\PREPA_SALAIRE\" & LeNom & "\")
If Existe2 = "" Then
MkDir ThisWorkbook.Path & "\PREPA_SALAIRE\" & LeNom & "\"
End If
chemin = ActiveWorkbook.Path
ActiveSheet.Copy
With ActiveWorkbook
.Title = ActiveSheet.Name
.Subject = ActiveSheet.Name
.SaveAs Filename:=chemin + "\PREPA_SALAIRE\" & LeNom & "\" + ActiveSheet.NameFile + ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
End With
End Sub |
Partager