Notes

Sub CopyFromMultipleWorkbooks()
Dim srcWb As Workbook
Dim srcSheet As Worksheet
Dim destSheet As Worksheet
Dim copyRange1 As Range, copyRange2 As Range
Dim destRange1 As Range, destRange2 As Range
Dim wbName As String
Dim col As Integer
Dim sheetPassword As String
Dim monthNames As Variant
Dim i As Integer
Dim filePath As String

' أسماء الأشهر
monthNames = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")

' ورقة العمل النشطة كوجهة
Set destSheet = ActiveSheet

' كلمة مرور حماية الورقة
sheetPassword = "your_password_here"

' تعطيل تحديث الشاشة لتحسين الأداء
Application.ScreenUpdating = False

' تكرار عبر جميع الأشهر
For i = 0 To 11
' تحديد اسم الملف
wbName = Format(i + 1, "00") & "- AS$VMD on-call (" & monthNames(i) & ").xlsx"

' تحديد المسار الكامل للملف (يجب تغييره لمجلد الملفات)
filePath = "C:YourFilePath" & wbName ' <-- استبدل بالمسار الفعلي

' التحقق مما إذا كان الملف موجودًا
If Dir(filePath) <> "" Then
' فتح الملف المصدر
Set srcWb = Workbooks.Open(filePath, ReadOnly:=True)
Set srcSheet = srcWb.Sheets(1) ' تعديل إذا كان اسم الشيت مختلفًا

' إلغاء حماية ورقة الوجهة
On Error Resume Next
destSheet.Unprotect Password:=sheetPassword
On Error GoTo 0

' نسخ النطاق الأول
Set copyRange1 = srcSheet.Range("A5:L49")
Set destRange1 = destSheet.Range("A5")

copyRange1.Copy
destRange1.PasteSpecial Paste:=xlPasteAll

' الحفاظ على عرض الأعمدة
For col = 1 To copyRange1.Columns.Count
destSheet.Columns(copyRange1.Columns(col).Column).ColumnWidth = srcSheet.Columns(copyRange1.Columns(col).Column).ColumnWidth
Next col

' نسخ النطاق الثاني
Set copyRange2 = srcSheet.Range("I1:K4")
Set destRange2 = destSheet.Range("I1")

copyRange2.Copy
destRange2.PasteSpecial Paste:=xlPasteAll

' الحفاظ على عرض الأعمدة
For col = 1 To copyRange2.Columns.Count
destSheet.Columns(copyRange2.Columns(col).Column).ColumnWidth = srcSheet.Columns(copyRange2.Columns(col).Column).ColumnWidth
Next col

' إغلاق الملف المصدر بعد النسخ
srcWb.Close False
End If
Next i

' إعادة تطبيق حماية الورقة
destSheet.Protect Password:=sheetPassword

' تمكين تحديث الشاشة
Application.ScreenUpdating = True

' رسالة نجاح
MsgBox "Data copied from all files successfully!", vbInformation, "Success"
End Sub