حسين مامون

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

جرب هذه الطريق لعلها تفيدك Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim h1, h2, dt1, dt2 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") Target.Offset(, 1) = Format(DateAdd("h", h2, h1), "mm-dd-yyyy hh:mm:ss") End If If Target = Empty Then Target.Offset(, 1).ClearContents End Sub add hour to date.xlsm

بما انك لم ترفع ملف او صورة تحاكي طلبك اليك هذه التجربة المتواضعة عليك بالضغط على الزر كلما فتحت الملف Option Explicit Sub dt() Dim dt, dt1, dt2 With Sheets(1) Range("j4") = Range("j6") Set dt = Range("j4") Set dt1 = .Range("j6") Set dt2 = .Range("k6") .Range("j6") = Date If dt1 = "" Then Exit Sub Else dt2 = Format(DateAdd("d", 1, dt1), "d") - Format(DateAdd("d", 1, dt), "d") .Range("k6") = Val(.Range("k6")) + dt2 Exit Sub End If End With End Sub test1.xlsm

بعد اذن الاستاد هشام واثراء للموضوع هذا حل اخر بالاكواد Option Explicit Sub test() Dim ws As Worksheet: Set ws = Sheets("Feuil2") Dim lr1, r Dim x1, x2 r = 2 Application.ScreenUpdating = False ws.Range("g2:j1000").ClearContents With Sheets("Feuil1") lr1 = .Cells(Rows.Count, 1).End(3).Row For x1 = 1 To 4 For x2 = 7 To 11 If .Cells(1, x1).Text = ws.Cells(1, x2).Text Then .Cells(2, x1).Resize(lr1).Copy ws.Cells(2, x2).Resize(lr1) GoTo 1 End If Next x2 1: Next x1 End With Application.ScreenUpdating = True End Sub Copie de TRANSFER-COLONE_Marcel32-v12.xlsm

بالنسبة للعد يمكنك استعمال هذه =COUNT(E1:E12) الطلب الثاني لم اتوصل بما تريد باستخدام التنسيق الشرطي ربما تكون فكرة اخرى من احد الاساتذة