عبدالله المجرب

Cells(Range("B2"), Range("B2")) = 555 هل تقصد هذا السطر اذا كنت تريد الخلية B2 تكون قيمتها 555 فهذا السطر عدله الى هذا Range("B2") = 555

السلام عليكم سيصبح الكود هكذا Private Sub CommandButton1_Click() ' Changes the Chart's XValue and Value ranges to display the selected data If TypeName(Selection) = "Range" Then If Selection.Columns.Count = 1 Then If Selection.Column = 2 Then 'If Selection.Areas.Count = 1 Then tt = Selection.Address For k = 1 To Len(tt) If Mid(tt, k, 1) = "B" Then If n = 1 Then Rng = Rng & "D" n = 0 Else Rng = Rng & "a" n = n + 1 End If Else Rng = Rng & Mid(tt, k, 1) End If Next t = Range("A1:D1," & Rng).Address ActiveSheet.ChartObjects("Chart 1").Activate ActiveChart.SetSourceData Source:=Range(t) 'Else ' MsgBox "Select a contiguous range of cells in column B.", vbInformation ' End If End If End If End If End Sub تم تعديل هذا السطر من الكود Rng = Rng & "D" وهذا t = Range("A1:D1," & Rng).Address

هل تقصد هكذا اسماء العملاء.rar

ضع ملف فيه بيانات كاملة حتى تتضح الصورة

ضع مرفق

لماذا لا تجعل للملف رقم سري وخلاص

إذا استخدم هذا الكود Sub w_Move() If Range("i1").Value > 0 Then If MsgBox("هل تريد إعادة الترحيل", vbYesNo, "تنبيه") = vbYes Then On Error Resume Next Application.ScreenUpdating = False Sheets("ورقة1").Select Range("d1:d8").Copy Range("a1").PasteSpecial xlPasteValues, xlPasteSpecialOperationAdd Range("a1").Select Application.CutCopyMode = False Application.ScreenUpdating = True Else MsgBox " الحمد لله " End If End If End Sub

السلام عليكم في المرفقات ملفين اكسل وورد في البداية (وفي كل عملية تحديث للبيانات قبل استخدامها في الدمج) افتح ملف الاكسل ثم قم بالضغط على زر تحديث قم بإغلاق ملف الاكسل افتح ملف الوورد (اذا دعت الحاجة الى تعريف بيانات دمج المرسلات فقط اعد تعريف البيانات ولكن اختر sheet2 لتكون المصدر وليس sheet1 (شاهد الصورة)) =============================== الفكرة كالتالي: استخدمت كود لترحيل الوجهات الست لكل سائق التي بها بيانات فقط من 27 وجهة متفرقة الى sheet2 لتكون هي مصدر بيانات دمج المرسلات ان شاء الله يكون هذا المطلوب عبدالله المجرب.rar

اليك الكود بعد التعديل Sub w_Move() If Range("i1").Value > 0 Then On Error Resume Next Application.ScreenUpdating = False Sheets("ورقة1").Select Range("d1:d8").Copy Range("a1").PasteSpecial xlPasteValues, xlPasteSpecialOperationAdd Range("a1").Select Application.CutCopyMode = False Application.ScreenUpdating = True Range("d1:d8").ClearContents Else MsgBox " الحمد لله " End If End Sub

ملف رائع جداً

روعة جميل جداً بارك الله فيك كل يوم نرى الجديد لديك

الاخوة الزملاء مجهود رائع جذاكم الله خير وبالتوفيق

عمل جميل ورائع ومفيد تسلم الايادي

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

عمل كبير واحترافيه عاليه

حياك الله اخي الفاضل تفضل

ضع هذا السطر في زر الامر الموجود في الملف Rows("4:40").Delete Shift:=xlUp

الى اي مدى تريد الحذف وهل من شروط للحذف

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

ما زلت تتحفنا بالروائع والدرر بارك الله فيك استاذ عبدالله

السلام عليكم استعمل هذا الكود في زر امر لاخفاء الصفوف Sub Hide() For Each cl In [G5:G300] If cl = 0 And cl <> "" Then cl.EntireRow.Hidden = True Next End Sub وهذا الكود في زر أمر للاظهار Sub Show() [G5:G300].EntireRow.Hidden = False End Sub

السلام عليكم استعمل هذه المعادلة في الخلية A3 واسحب اسفل =IF(OR(C3<=0;C3="");"";SUBTOTAL(3;$C$3:C3)-COUNTIF($C$3:$C3;0))

ما شاء الله عمل مميز

هذه هي عائلة أوفيسنا جسد واحد اذا اشتكى منه عضو تداعى له سائر الجسد بالسهر والحمى بارك الله فيكم وجعل محبتكم في الله ابواحمد

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