وعليكم السلام جرب الملف المرفق
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