الاقسام

هذا الكود يقوم بما يلزم تغيير اسماء الصفحات الى اللغة الأجنبية لحسن نسخ الكود ولصقه Option Explicit Sub Extarct_Data() Rem Created By Salim Hasbaya on 29/5/2020 Dim M As Worksheet, L As Worksheet, R As Worksheet Dim Rg_M As Range, Rg_L As Range Dim I%, Lr_M%, Lr_L%, RO% Dim St_Date As Date, End_Date As Date Set M = Sheets("Minho"): Set L = Sheets("Laho") Set R = Sheets("Repport") Lr_M = M.Cells(Rows.Count, 1).End(3).Row Lr_L = L.Cells(Rows.Count, 1).End(3).Row R.Range("B2").Resize(25, 2).ClearContents If Not IsDate(R.Range("D2")) Or Not IsDate(R.Range("D2")) Then _ MsgBox "Type Please Correct Dates In The Cells D2 and E2 ": Exit Sub St_Date = Application.Min(R.Range("D2:E2")) End_Date = Application.Max(R.Range("D2:E2")) '++++++++++++++++++++++++++++++++++++++++ With M .Range("A2:AC" & Lr_M).Interior.ColorIndex = xlNone RO = 2 For I = 2 To Lr_M If .Cells(I, 1) <= End_Date _ And .Cells(I, 1) >= St_Date Then .Cells(I, 1).Resize(, 29).Interior.ColorIndex = 6 R.Cells(RO, 2) = Application.Sum(.Cells(I, 4).Resize(, 26)) RO = RO + 1 End If Next I End With '++++++++++++++++++++++++++++++++ With L .Range("A2:AC" & Lr_L).Interior.ColorIndex = xlNone RO = 2 For I = 2 To Lr_L If .Cells(I, 1) <= End_Date _ And .Cells(I, 1) >= St_Date Then .Cells(I, 1).Resize(, 29).Interior.ColorIndex = 6 R.Cells(RO, 3) = Application.Sum(.Cells(I, 4).Resize(, 26)) RO = RO + 1 End If Next I End With End Sub الملف مرفق       From_To.xlsm

المعذرة ارجو الاطلاع على هذه النسخة من البرنامج حيث ان السابقة غير معدلة _برنامج_محاسبي_لنقاط_البيع_الاصدار_الاول_نسخة.rar

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله خيرا بالتوفيق

جزاك الله خيرا اخى @فايز.. 💐 جهد عالى وشغل مزاج الله ينور ربنا يوفقك تم ضبط حقول التاريخ الهجرى بالنموذج من غير منضمه الى منضمه وبعد اختيار التاريخ الميلادى والخروج منه سيتم تحديث حقل التاريخ الهجرى ربنا يوفقك ويزيدك من فضله وعلمه 💐 T1(1).accdb

بارك الله فيكم واعتذر عن عدم ارسال نموذج مرفق وسأقوم بتجربة الكود ولكم جزيل الشكر