عبدالفتاح في بي اكسيل

كان  من  المفترض  توضيح   ما  تريد  حتى  يتم  العمل  على  الملف  منذ  البداية   
تفضل
 
نصرالدين البلداوي.xlsm

يمكنك اضافة  رموز  اخرى تفضل  هذا  الكود 
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) On Error Resume Next If InStr("/\? * [ ]", Chr(KeyAscii)) Then KeyAscii = 0 End Sub  

تاكد  من هذا  البرنامج Net framework  موجود  في جهازك  وان  يكون اخر  اصدار  لعل  المشكلة منه 

لقد  قلت  لك   بعد  ثاني  سطر  في الكود  خطاك   قمت  بوضعه  بعد  اول  سطر 
تفضل 
تنسيق شرطى لكل الملف.xlsm

جرب  هذا  الكود  لعله  يفي  بالغرض 
Sub Test() Application.ScreenUpdating = False Dim i As Long Dim Lastrow As Long Lastrow = Cells(Rows.Count, "f").End(xlUp).Row For i = Lastrow To 1 Step -1 If Cells(i, "f").Value = "1/3" Or Cells(i, "f").Value = "2/3" Then Rows(i).Delete Next Application.ScreenUpdating = True End Sub  

تفضل  عدل  تاريخ  الكمبيوتر  ومن  ثم  نشط  الخلية b2
dt .xlsm

هذه  محاولة  ولكن  يجب  ان  تتاكدي  من  عملية    اضافة  التاريخ  الجديد   لست  متاكد  اذا  كانت  تعمل  بشكل  جيد 
date of birth.xlsm

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

جرب هذه  المعادلة 
=ROUNDUP(B8;0)  

اعتقد  ان هذا  ها  تريده 
ترحيل.xlsm

تفضل
Copy of Book12.xlsx

اخي  الكريم  تفضل  هذا  الملف  شبيه  الى  حد ما  لطلبك  عليك  الكتابة   وسيتغير  تلقائيا  ولكن  عليك  دراسة  الكود  والتطبيق  حتى  يمكنك  التغيير بناء  على احتياجاتك 
color.xlsm

اسف  اخي  الكريم   لقد  اخطات  بالمدى 
تفضل 
اخر عملية وعدد الشهور2.xlsx

اخت زهرة  ضعي  هذا  الكود  في  حدث textbox1 واتبعي  نفس  خطوات  الشرح  في  الصورة 
Private Sub TextBox1_Change() If Len(Dir(ThisWorkbook.Path & "\" & TextBox1.Value & ".jpg")) > 0 Then Image1.Picture = LoadPicture(ThisWorkbook.Path & "\" & TextBox1.Value & ".jpg") Else Image1.Picture = LoadPicture("") End If End Sub  

على  حد  علمي  يمكنك  استدعاءه  عن طريق  ادراج  موديل  خاص   او زر  تحكم  بالمكروات  المطلوب  استدعائها    كتابة    كلمة  call ثم  اسم  الماكرو   
مثلا   لديك  اكثر  من ماكرو   sub   macro1()   , sub macro2     
تكتب     call macro1   , call macro 2 

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

ضع الكود في حدث  this workbook
Private Sub Workbook_Open() Dim c As Range For Each c In Range("c2:c4") c.Formula = "=TickerChart|Live!'QO." & c.Offset(, -2).Value & ".TAD$lasttradeprice'" Next c Dim d As Range For Each d In Range("d2:d4") d.Formula = "=TickerChart|Live!'QO." & d.Offset(, -3).Value & ".TAD$lasttradeprice'" Next d Dim e As Range For Each e In Range("e2:e4") e.Formula = "=TickerChart|Live!'QO." & e.Offset(, -4).Value & ".TAD$lasttradeprice'" Next e End Sub 9.xlsm

اخي مصطفى تفضل  على حسب ما فهمت رغم انه  الشرح غامض   
يجب عليك  كتابة الشهر في الخلية a2 
=IFERROR(SUMPRODUCT(('2020'!$B$4:$B$6000=$A8)*(TEXT('2020'!$D$4:$D$6000&"-"&'2020'!$E$4:$E$6000;"YYYYMM")<=TEXT($A$2&"-"&D$6;"YYYYMM"));'2020'!$F$4:$F$6000);"")   
MMM1.xlsx

اخي  هذه  محاولة مني  بالكود   عن  نفسي  افضل  الاكواد  ديناميكية  وسريعة  من  غير سحب  المعادلات  اذا  زادت البيانات
ملاحظة  اكتب  البيانات  في  العمود  a  فقط  وسيجلب  البيانات  الكود 
Sub tr() Dim lr As Integer Application.ScreenUpdating = False lr = Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To lr Cells(i, 3) = Cells(i, 1) Next Range("c:c").Copy Destination:=Range("E1") Application.ScreenUpdating = True End Sub  
 
 
المصنف1.xlsm

تفضل  اخي  لعله  المطلوب 
Book1 (1).xls

تفضل لعله المطلوب 
الدوال في العمود g        
=IFERROR(INDEX(C$4:C$1000;MATCH($F5;$B$4:$B$1000;0));"") في العمود h
=IFERROR(INDEX(D$4:D$1000;MATCH($F4;$B$4:$B$1000;0));"")  
sheet.xlsx

جرب هذا  الكود  لعله المطلوب 
Sub SAVESHEETS() With Application .DisplayAlerts = False .ScreenUpdating = False End With For Each sh In ThisWorkbook.Worksheets sh.Copy ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & ActiveSheet.Name & ".xlsx" ActiveWorkbook.Close False Next With Application .DisplayAlerts = True .ScreenUpdating = True End With End Sub  
SAVESHEET.xlsm

اخي  يجب ان تطابق  ما بين اليوزرفورم والشيت بخصوص العناصر التي يتم ترحيلها وجدت صعوبة في المطابقة  الكلمات ليس نفسها   كما يوجد خلايا مدمجة    بالنسبة لي لااعلم طريقة الترحيل  للخلايا  المدمجة  عليك بالغاء الدمج ان اردت المساعدة   هذا ما استطعت القيام به 
user.xlsm

هذه محاولة  تفضل  لعله ما تريد
ملاحظة : لا تضغط  الملف مرة اخرى   الملف صغير  لا يستحق  ذلك  كما  ان التيكست بوكس  ارقامه غير منظمة   نسقه  تجنب  لاي خطا بالكود 
Private Sub listbox1_Click() CheckThis = False If ListBox1.ListIndex = -1 Then MsgBox "Nothing Selected!" Exit Sub End If For i = 1 To 18 Me("TextBox" & i).Text = ListBox1.Column(i - 1) Next CheckThis = True End Sub  
wdad mtn(tora(v1).xlsm

بعد اذن أستاذ احمد تفضل اخي هذا بالكود بعد كتابة الارقام  اضغط على ايقونة العدسة  وسيتم جلب البيانات 
Sub EtaEng() Dim idnum As Variant, b As Object, i As Double Sheet2.Activate idnum = Left(Range("D7").Value, 4) Set b = Sheet1.Columns("b").Find(idnum, lookat:=xlPart, LookIn:=xlValues) If Not b Is Nothing Then 'exists i = b.Row Range("D10").Value = Sheet1.Cells(i, 3) Range("D12").Value = Sheet1.Cells(i, 2) Range("D14").Value = Sheet1.Cells(i, 4) Range("D16").Value = Sheet1.Cells(i, 5) Range("H10").Value = Sheet1.Cells(i, 6) Range("H12").Value = Sheet1.Cells(i, 7) Range("H14").Value = Sheet1.Cells(i, 8) Range("H16").Value = Sheet1.Cells(i, 9) Else MsgBox "هذا الرقم غير موجود", vbExclamation End If End Sub ملاحظة  : يمكنك  تغيير عدد الارقام كما تشاء من خلال هذا  السطر   وهو مصمم لاربعة ارقام  ويجب ان تكتب الارقام من اليسار الى اليمين كما ترى 
idnum = Left(Range("D7").Value, 4)  
كشف_المحتاجين_2.xlsm