حسين مامون

وجزيت خيرا اخي تفضل ولكن هناك بعض الاشياء يجب شرحها كما شرحت الاخرى مثلا: كرة قدم جاري اي عمود توجد وماهو الشرط كذلك باقي المعطيات الاخرى داتا-1.xlsm

جرب الادخال في c3 او d3 بالنسبة للترحيل غدا ان شاء الله كود للترحيل مع الجمع.xlsm

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

وعليكم السلام ورحمة الله استاذ Jehad.93 ذكرت انك تريد الاستعلام بشروط معينة ولكن ملفك ينقصه شيء والله أعلم والله حاولت افهم الموضوع في اي خلية او خلايا نضع او نكتب الشرط وفي اي شيت حاول وضع بعض البيانات كما تريدها او تتصورها في التقرير وللاستعلام لابد من خلية او تيكستبوكس او كومبوبوكس اعد تصميم للملف واشرح ما تريد بلغة الاكسيل . مثلا اريد الاستعلام بشرط عند ادخال تاريخ او اسم او كود في الخلية b2 شيت data

Sheets("ورقة").RAnge("a1").Select اذا كان اسم الشيت هو : ورقة3 نكتب في الكود: ("ورقة3")Sheets

استخدم الدالة COUNTIF =COUNTIF(C3:C12;"ح") =COUNTIF(C3:C12;"غ")

جزاك الله خيرا

جرب ...عليك بربط الزر بالماكرو المسمى test ...كليك يمين على الزر ثم Assing macro ثم كليك يسار على test ثم OK نموذج بيانات الموردين.xlsm

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

جرب المرفق ...كلمة المرور 123 اضهار شيت الاكسل بكلمة مرر.xls

بدون زر ادخل قيمة في المدى J8:J1000 وسيرحل الى الشيت الاخر باذن الله تحياتي ...الكود في حدث الشيت Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim ws As Worksheet Set ws = Sheets("البيانات") Dim c, x Application.ScreenUpdating = False If Not Intersect(Target, Range("j8:j1000")) Is Nothing Then c = Target.Offset(, -9) x = Application.Match(c, ws.Columns(1), 0) 'Target.Copy ws.Cells(x, 1).Offset(, 19) = Target End If Application.ScreenUpdating = True End Sub ترحيل ارقام من شيت الى شيت.xlsm

استاذ وائل عبد الصمد ...اظن ملفك بحاجة الى اعادة تصميم اولا يجب ان تكون هناك صفحة فيها قاعدة بيانات بجميع البيانات التي ستحتاجها وفي الصفحة الثانية جدول واحد فقط هكذا يمكنك طباعة اي اذن بشرط مثلا الاسم او كود العميل. حاول عمل ملف بهذه المواصفات يعني صفحة قاعدة بيانات وصفحة للطباعة وستجد من يقدم لك حلا ان شاء الله.

تفضل جرب Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim x Dim lr Dim lrr On Error Resume Next lrr = Cells(Rows.Count, "c").End(3).Row If Not Intersect(Target, Range("c2:c" & lrr)) Is Nothing Then If Target = "" Then Exit Sub lr = Cells(Rows.Count, "e").End(3).Row For x = 4 To lr If Target.Offset(, -1).Text = Cells(x, "e").Text Then Cells(x, "f") = Val(Cells(x, "f")) + Val(Target): Exit For End If Next x End If End Sub مخزن 1992.xlsm

اليك هذا عند اختيار الصنف يتم الاستعلام عن الصنف المختار وعند اختيار المقاس يستعلم عن المقاس والنتيجة تظهر الماركة و السعر و الكادر و مواصفات ولكن لازم تختار الصنف اولا ...ومرة اخرى الخلايا المدمجة لازم تحدفها ...تحياتي التعديل المطلوب (1).xlsm

جرب المرفق انقر زر بحث في شيت بحث ..ملاحظة تم تحويل ملفك الى امتداد xlsm التعديل المطلوب (1).xlsm

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

تفضل ..لا اعرف ماذا تقصد ب ادراج حجز علما انك وضعت كود ترحيل فورم ادخال بيانات ديناميكى (1).xlsm

جرب المرفق فورم ادخال بيانات ديناميكى (1).xlsm

اخي الكريم munear جرب المرفق ..ادخل المودييل اولا ثم تاريخ الاستلام تثبيت معادلة.xlsm

جرب المرفق تثبيت معادلة.xlsm

Option Explicit Sub stabelerFR() Dim lr Dim r lr = Cells(Rows.Count, "e").End(3).Row r = "=VLOOKUP(H10,أسعار!B:C,2,)" Range("e10:e" & lr).Formula = r Range("e10:e" & lr).Value = Range("e10:e" & lr).Value End Sub استعمل هذا الشيء سيفي بالغرض ..ولكن لازم تحفظ الملف بامتداد xlsm

بعد اذن الاخوة هذا الشيء ينسخ المدى المحدد ويحوله الى pdf حدد المدى الذي تريد وفعل الماكرو Option Explicit Sub rngSelect() Dim R Dim fil_name fil_name = ThisWorkbook.Path & "\" & fil_name & Format(Now(), "dd-mm-yyyy- hh.mm.ss") R = (Selection.Address) Range(R).ExportAsFixedFormat Type:=xlTypePDF, Filename:=fil_name MsgBox "النسخة تجدها في نفس مكان الملف الاصلي", vbInformation End Sub

وجزيت خيرا اخي

اخي الكريم أبو إيمان تفضل Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim h1, h2, dt1, dt2, R1, R2 If Not Intersect(Target, Range("k2:k1000")) Is Nothing Then h2 = Target h1 = Format(Target.Offset(, -2), "dd-mm-yyyy") & " " & Format(Target.Offset(, -1), "hh:mm:ss") R1 = Format(DateAdd("h", h2, h1), "mm-dd-yyyy hh:mm:ss") R2 = Format(DateAdd("s", Target.Offset(, 1) * (60), R1), "DD-MM-yyyy hh:mm:ss") Target.Offset(, 2) = R2 End If If Target = Empty Then Target.Offset(, 1).Resize(, 2).ClearContents End Sub add hour to date.xlsm