رجب جاويش

بارك الله فيك أستاذ محمد برجاء الاستمرار

يشرفنى صداقتك أخى الفاضل ابو حمادة

جزاك الله خيرا أخى الفاضل ابو حمادة شكرا جزيلا على هذا الدعاء الطيب

تفضل أخى الدوائر الحمراء.rar

حاضر أخى الفاضل بس اعذرنى اذا لم اتمكن اليوم يكون غدا ان شاء الله

اخى ابو حمادة تم عمل المطلوب على رابط موضوع كود الدوائر الحمراء تعديل كود للدوائر الحمراء

تفضل أخى جرب المرفق تم تظبيط كود الدوائر فى صفحة AA جرب وأخبرنى بالنتيجة الدوائر الحمراء.rar

على فكرة الموضوع أصبح ملحوظ ومتكرر عدد غير قليل من الموضوعات الجديدة يتم تكراره مرتين أو أكثر

أخى الصقر أخى ياسر ما فهمته أنا من سؤال الأخت الفاضلة كالاتى : يوضع رقم فى الخلية A3 ثم يتم البحث عنه وعند ايجاده يتم وضع اسم الصفحة التى يوجد بها فى الخلية B3 واسم الخلية الذى يوجد بها الرقم فى الخلية C3

تفضل أخى تم وضع تاريخ الشهر فى الصفحة D فى العمود A بالمثل كما فى صفحة الارشيف ترحيل بيانات.rar

ولاثراء الموضوع هذا كود آخر Private Sub Worksheet_Change(ByVal Target As Range) Dim LR As Long, x As Long, i As Integer, D As Boolean Dim ws As Worksheet, cl As Range '================================================== If Target.Address = [A3].Address Then x = Val([A3]) For i = 1 To 3 LR = Sheets(i).Range("A10000").End(xlUp).Row For Each cl In Sheets(i).Range("A1:A" & LR) If cl = x Then [B3] = Sheets(i).Name [C3] = cl.Address(0, 0) D = True Exit For End If Next Next If Not D Then Range("B3:C3") = "رقم غير موجود" End If End Sub مثال2.rar

عذرا أخى الفاضل أقصد بان تضع السطر الخاص بالحماية بعد هذا السطر Set Sh = ورقة3

أخى الفاضل محمد هذا الخطأ نتيجة حماية صفحة ( كشف ) ولتلافى هذا الخطأ كما أخبرك أخى ابراهيم تضع السطر التالى فى أول الكود لفك الحماية ( بفرض كلمة المرور 1234 ) Sh.Unprotect "1234" والسطر التالى فى اخر الكود لارجاع الحماية Sh.Protect "1234"

تفضل اخى ترحيل بيانات.rar

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

أخى الفاضل / مختار جزاك الله خيرا على هذا المرور العطر ويظهر ان الحل الوحيد لنسيان تعريف المتغيرات هو Option Explicit أصبت وأحسنت تقبل تحياتى

أخى الفاضل برجاء مزيد من التوضيح

تفضل أخى ترحيل بيانات.rar

أخى أحمد جزاك الله كل خير على المرور العطر أخى أيمن ادخل على هذا الرابط اعمل شاشة دخول برنامجك بنفسك وسيبك من التقليد

إخوتى الأفاضل جزاكم الله خيرا على هذه الاسهامات الجميلة والتى تكون مفيده بشكل عام للإخوة الأعضاء ولكن بالنسبة لصاحب السؤال قد تكون مثل الحرث فى الماء ما لم يرفق ملف يوضح به مثال لما يريده

أخى الفاضل تم فعلا التجهيز لترحيل 1000 صف عن طريق مسح 1000 صف من الصفحات المرحل اليها لاستقبال البيانات المرحلة ويمكن زيادة العدد عن زيادة العدد فى الصف التالى من الكود الى اى عدد تريده sh.Range("A1:J1000").ClearContents أما مسح البيانات المرحلة فيحتاج بعض التعديلات فى الكود فاذا كنت فى احتياج لمسح البيانات بعد الترحيل أخبرنى

هل تقصد هكذا ترحيل بيانات.rar

أخى الفاضل / عبد العزيز جزاك الله كل خير على هذه الكلمات الطيبة وان شاء الله يتوفر الوقت وأقوم بعمل هذا الشرح

أخى الفاضل / nasersaeed أخى الفاضل / السمالوطى جزاكم الله خيرا على هذه الكلمات الطيبة

السلام عليكم جرب أخى هذا الكود يقوم بالترحيل مع انشاء الصفحات مع نسخ التنسيقات لعله يكون كما يريد Sub ragab() Dim cl As Range, sh As Worksheet Application.ScreenUpdating = False For Each sh In ThisWorkbook.Worksheets If Not sh.Name = "البيانات" Then sh.Range("A1:J1000").ClearContents End If Next LR1 = Cells(Rows.Count, 6).End(xlUp).Row LR2 = Cells(Rows.Count, 8).End(xlUp).Row Set Rng1 = Range("F2:F" & LR1) Set Rng2 = Range("H2:H" & LR2) Set Rng = Union(Rng1, Rng2) For Each cl In Rng x = Trim(cl.Value) On Error Resume Next If Worksheets(x) Is Nothing Then Sheets.Add.Name = x Sheets(x).Move After:=Sheets(Sheets.Count) End If Sheets("البيانات").Range("A1:J1").Copy Sheets(x).Range("A1").PasteSpecial xlPasteValues Sheets(x).Range("A1").PasteSpecial xlPasteFormats Sheets("البيانات").Cells(cl.Row, 1).Resize(1, 10).Copy Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial xlPasteValues Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row, 1).PasteSpecial xlPasteFormats Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row, 1).PasteSpecial xlPasteColumnWidths Application.CutCopyMode = False Next MsgBox "تم الترحيل بنجاح الى صفحات منفصلة" Sheets("البيانات").Select Application.ScreenUpdating = False End Sub 2متابعة .rar