سليم حاصبيا

الدرحة غير موجودة أصلاً في الملف

جرب هذا الملف (بعد اذن اخي به علية) تم تغيير اسماء الصفحات لحسن عمل الكود الكود Option Explicit Sub get_data() Dim i%, m%: m = 9 Dim Sh As Worksheet: Set Sh = Sheets("Final_Year") Dim Th As Worksheet: Set Th = Sheets("Natija") Dim x%: x = Application.Match(Th.Range("d2"), Sh.Rows(7), 0) Dim My_Rg_To_Copy As Range: Set My_Rg_To_Copy = Sh.Range("a8").CurrentRegion.Columns(x) Dim last_row%: last_row = My_Rg_To_Copy.Rows.Count + 6 Dim Nisba# Th.Range("a8").CurrentRegion.Offset(1).ClearContents If Not IsNumeric(Th.Range("e4")) Or Th.Range("e4") = vbNullString Then Nisba = (65 / 100) * My_Rg_To_Copy.Cells(2) Else Nisba = (Th.Range("e4") / 100) * My_Rg_To_Copy.Cells(2) End If For i = 9 To last_row If Sh.Cells(i, x) >= Nisba Then Th.Cells(m, 2).Resize(1, 6).Value = Sh.Cells(i, 2).Resize(1, 6).Value Th.Cells(m, 1) = m - 8 m = m + 1 End If Next Set My_Rg_To_Copy = Nothing: Set Sh = Nothing: Set Th = Nothing End Sub الملف مرفق Get data Salim.xls

قم بالعمل حسب ما تراه قي هذا الملف Marche.docx

ريما كان الحل هنا SALIM1_salim.xlsx

اين هي هذه الفواتير كي يتعرف عليها الاكسل و يقوم بادراجها حسب التاريح المطلوب لم اجد اي تاريخ ولا اي فاتورة في اي صفحة

جرب هذا الملف اعدادى Salim.xls

لم تفعل شيئاً ما وال البرنامج يطلب الباسوورد

انسخ هذه المعادلة الى الخلية A2 و اسجب نزولاً حتى الخلية A32 =IF(ROWS($A$1:A1)>DAY(EOMONTH($D$1,0)),"",DATE(YEAR($D$1),MONTH($D$1),ROWS($A$1:A1)))

اين رفع الحماية

لا يمكن للفلتر ان يعمل على جدولين في نفس الصفحة (كيف اذا كانا في صفحتين مختلفتين..؟؟؟)

لحسن العمل مع لغة VBA تم تغيير اسماء الصفحات الى الاجنبية الكود Option Explicit Sub filter_for_ME() With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim S_sh As Worksheet: Set S_sh = Sheets("MouwariDDin") Dim T_sh As Worksheet: Set T_sh = Sheets("Search_") Dim My_Table As Range: Set My_Table = S_sh.Range("A1").CurrentRegion T_sh.Range("a5").CurrentRegion.ClearContents T_sh.Range("q2").Formula = "=AND($A2>=Search_!$B$2,$A2<=Search_!$B$3,Search_!$C$2=$B2,Search_!$D$2=$D2)" My_Table.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=T_sh.Range("Q1:q2"), _ CopyToRange:=T_sh.Range("A5:G5") T_sh.Range("q2").ClearContents With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub الملف معادلة ترحيل ونقل Salim.xls

يمكنك ان تستعين بهذا الملف واضافة النطاق الذي تريده ضمن الكود Date_Picker.xlsm

شاهد هذا الفيديو

ارفع مثالاً عما تريد و اي اوراق تريد اخفائها

ريما يكون هذا المطلوب 33 salim.xls

ممكن هذا الملف يلبي الحاجة Date_without_days_by_colums.xlsm

يمكن ان يكون المطلوب Dates.xlsx

هذا يتعلق يالداكرة الموجودة بالجهاز RAM مثلا الجهاز Mb60 و 64 bit يتستطيع انشاء حوالي 10.000 (عشرة الاف ورقة عمل)

المطلوب غير واضح ادرج جدولاً فيه بيانات وحدزل اخر بالنتائج المتوقعة

تم التعديل لتيحث عن اي (حرف او حروف) اينما وجدت العامود G m Salim1.xlsx

أول تعديل يمكن اجراؤه هو استبدال الماكرة لتعبئة البيانات يهذا الكود القصير Private Sub CommandButton2_Click() Dim lastrow As Integer Dim i% lastrow = [b1000].End(xlUp).Row + 1 For i = 2 To 11 Cells(lastrow, i).Value = Me.Controls("TextBox" & i - 1).Value Me.Controls("TextBox" & i - 1) = "" Next MsgBox " تم الحفظ ", vbInformation, "Rose Alsham Asad" End Sub

جرب هذا الملف (يمكن الاضافة على الاسماء قدر ما تشاء ولا تقم بالترقيم في جدول الاسماء فإن اكسل يفعلها اوتوماتيكياً) m Salim.xlsx

جرب هذا الكود Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Address = "$A$1" Then Dim New_val, Old_val New_val = Target.Value If Not IsNumeric(New_val) Then New_val = 0 Application.Undo Old_val = Target.Value Target.Value = New_val + Old_val End If Application.EnableEvents = True End Sub

الكود Sub hide_col() Range("B:C,F:G,J:J").EntireColumn.Hidden = True End Sub

قم بتغيير كافة اسماء Lebel من خلال Properties الى LB2 LB1 ,وهكذا اذ ربما يكون Lebel1 او Lebe2 غير موجود حقيقة( تم ادراجه ثم مسحه) الملف مرفق Book1 salim.rar