وعليكم السلام جرب الملف المرفق
 
	 
 
Sub SaveWorkbookWithPasswordMonthYear()
    Dim originalWorkbook As Workbook
    Dim newWorkbook As Workbook
    Dim newFilePath As String
    Dim password As String
    Dim monthYear As String
    
    ' تعيين الملف الأصلي
    Set originalWorkbook = ThisWorkbook
    
    ' الحصول على اسم الشهر والسنة الحاليين
    monthYear = Format(Date, "mmmm yyyy")
    
    ' تحديد مسار الملف الجديد مع اسم الشهر والسنة
    newFilePath = Application.GetSaveAsFilename(InitialFileName:=monthYear & ".xlsb", FileFilter:="Excel Files (*.xlsb), *.xlsb")
    
    ' تعيين كلمة المرور
    password = InputBox("أدخل كلمة المرور للملف الجديد:")
    
    ' حفظ نسخة من الملف الأصلي
    originalWorkbook.SaveCopyAs newFilePath
    
    ' فتح النسخة الجديدة
    Set newWorkbook = Workbooks.Open(newFilePath)
    
    ' حفظ النسخة الجديدة مع كلمة المرور
    newWorkbook.SaveAs Filename:=newFilePath, password:=password
    
    ' إغلاق النسخة الجديدة
    newWorkbook.Close SaveChanges:=True
    
    MsgBox "تم حفظ النسخة الجديدة باسم الشهر والسنة وكلمة المرور بنجاح!"
End Sub
	سلف شهر 8.xlsb