حسونة حسين

وعليكم السلام ورحمة الله وبركاته رسائل كاش.xlsx

الشكر لله اخى الحمد لله الذي بنعمته تتم الصالحات

وعليكم السلام ورحمه الله وبركاته تفضل اخى جرب هذا التعديل Option Explicit Private Sub CommandButton1_Click() Dim Ws As Worksheet, CEl As Range, Sheets_name As Variant, Sh, Temp() Dim Str As String, i As Long, j As Long, Lr As Long Str = Me.TextBox1.Value Sheets_name = Array("عين غزال", "الجبيهة", "الجبيهة", "أربد", "الزرقاء") i = 0 For Each Sh In Sheets_name Set Ws = ThisWorkbook.Sheets(Sh) Lr = Ws.Cells(Ws.Rows.Count, 9).End(xlUp).Row For Each CEl In Ws.Range("A2:J" & Lr) If InStr(CEl.Value, Str) > 0 Then i = i + 1 ReDim Preserve Temp(1 To 12, 1 To i) For j = 1 To 10 Temp(j, i) = Ws.Cells(CEl.Row, j).Value Next j Temp(11, i) = Ws.Name Temp(12, i) = CEl.Address End If Next CEl Next Sh If i = 0 Then MsgBox "ما تحاول البحث عنه غير موجود في الاسواق ", vbInformation + vbSystemModal, "نظام البطاقات الائتمانية - Search " TextBox1.Text = "" Else Temp = Application.Transpose(Temp) With Me.ListBox1 .ColumnCount = 12 .ColumnWidths = "96,96,96,96,140,96,96,96,96,96,96,96" .Clear .List = Temp End With End If End Sub جديد.xlsm

وعليكم السلام ورحمة الله وبركاته بارك الله فيك ابو حبيبه وجعله الله في ميزان حسناتك يوم القيامة

بالضغط كما بالصورة ثم اختيار الملف الذي تريده

تفضل اخى ارسال واتساب.xlsm

السلام عليكم ورحمة الله وبركاته وبها نبدأ بارك الله فيك أخي @mahmoud nasr alhasany على اتباع تعليمات المنتدى اخى @Ahmed Saad 2017 يمكنك ارسال الملف لعل اخونا @mahmoud nasr alhasany يفيدك

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

الحمد لله الذي بنعمته تتم الصالحات تحت امرك اخي ابو مالك

ما هو الذي لا يعمل اخي هل تعلم كيف يتم العمل علي هذا الملف تختار شيك بوكس اما Entree او Sortie ثم تكتب البيانات التي تريدها ثم تضغط علي ذر Ver la liste ثم تضغط علي الزر Valider

ولو تحقق الشرطان ماذا يكنب

وعليكم السلام ورحمة الله وبركاته ما هي النتيجه المطلوبه

الشكر لله اخي الحمد لله الذي بنعمته تتم الصالحات

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

السلام عليكم ورحمه الله وبركاته تفضل لعله طلبك فقط النطاق المسمي Data تم تمديده لحل مشكلتك ‏‏‏‏جديد 1.xlsm

وعليكم السلام ورحمه الله وبركاته تفضل اخى Private Sub TextBox2_Change() Application.OnTime Now() + TimeValue("00:00:02"), "ورقة1.test" End Sub Sub test() Dim Wb As Workbook, WbName As String, xWb As Workbook Dim ws As Worksheet, sh As Worksheet Dim X, M, N Set ws = ThisWorkbook.Worksheets("ورقة1") If TextBox2 = "" Then AutoFilterMode = False Else WbName = "2024.xlsm" WbPath = ThisWorkbook.Path & "\" & WbName For Each Wb In Workbooks If Wb.Name = WbName Then Exit For Next On Error Resume Next Set Wb = Application.Workbooks.Item(WbName) On Error GoTo 0 If Not Wb Is Nothing Then Set sh = Wb.Worksheets("الأرصدة") ws.Range("H1").AutoFilter , field:=8, Criteria1:=TextBox2.Text 1 M = Application.Match(CDbl(Date), sh.Rows(2), 0) If IsError(M) Then ' insert column to date if not found N = Application.Match("*", sh.Rows(2), 0) sh.Columns(N).Insert sh.Cells(2, N).Value = Date GoTo 1 End If X = Application.Match(Val(TextBox2), sh.Columns(M + 2), 0) If Not IsError(X) Then With sh.Cells(X, M) .Value = ws.Cells(1, "I").Value .Interior.ColorIndex = 30 .Font.ColorIndex = 20 End With Wb.Save ' Save sheet after set data End If End If End If End Sub

تفضل اخى الكود بطريقه ثانيه لعلها تكون المطلوبه Private Sub TextBox2_Change() Application.OnTime Now() + TimeValue("00:00:02"), "ورقة1.test" End Sub Sub test() If TextBox2 = "" Then AutoFilterMode = False Else Range("H1").AutoFilter , field:=8, Criteria1:=TextBox2.Text Dim X X = Application.Match(Val(TextBox2), ورقة3.Columns(4), 0) If Not IsError(X) Then With ورقة3.Cells(X, "B") .Value = ورقة1.Cells(1, "I").Value .Interior.ColorIndex = 30 .Font.ColorIndex = 20 End With End If End If End Sub

وجزاكم مثله اخى

تفضل اخى ويرجى تعديل اسم الظهور الخاص بك الى اللغه العربية من لوحة التحكم بالضغط على اسمك اعلي يسار المنتدى وفق قواعد المشاركة office.xlsm

تفضل اخى ارسال واتساب.xlsm

فقط تم اخفاء السطور وتم اخفاء الاعمده

وجزاكم مثله ابو مالك على سرعه الاستجابه😍

مثل هذا 2024.zip

للرفع

وعليكم السلام ورحمه الله وبركاته يوجد بيانات عندك حتى العامود S كما بالصورة كما يوجد بيانات حتى الصف رقم 36222 كما بالصورة التالية ويرجى تعديل اسم الظهور الى اللغه العربية من لوحة التحكم بالضغط على اسمك اعلي يسار المنتدى وفق قواعد المشاركة