الجموعي

السلام عليكم ورحمة الله تعالى وبركاته اقدم لكم هذا الفورم البسيط للترحيل في العمود A مثلا وهذا بفضل أساتذتي الكرام في هذا الصرح العظيم أكواد الترحيل 1 Dim ws As Worksheet Dim lr As Long '--------------------------------------------- Set ws = ThisWorkbook.Sheets(1) '--------------------------------------------- lr = ws.Cells(Rows.Count, "A").End(xlUp).Row ws.Cells(lr + 1, 1) = Me.TextBox1.Text '--------------------------------------------- 2 Dim ws As Worksheet Dim lr As Long '--------------------------------------------- Set ws = ThisWorkbook.Sheets(1) '--------------------------------------------- lr = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1 ws.Cells(lr, 1) = Me.TextBox1.Text '--------------------------------------------- 3 Dim ws As Worksheet Dim lr As Long '--------------------------------------------- Set ws = ThisWorkbook.Sheets(1) '--------------------------------------------- lr = Range("A65536").End(xlUp).Row ws.Cells(lr + 1, 1) = Me.TextBox1.Text '--------------------------------------------- 4 Dim ws As Worksheet Dim lr As Long '--------------------------------------------- Set ws = ThisWorkbook.Sheets(1) '--------------------------------------------- lr = Range("A65536").End(xlUp).Row + 1 ws.Cells(lr, 1) = Me.TextBox1.Text '--------------------------------------------- 5 Dim ws As Worksheet Dim lr As Long '--------------------------------------------- Set ws = ThisWorkbook.Sheets(1) '--------------------------------------------- lr = ws.Cells(Rows.Count, 1).End(xlUp).Row - 1 ws.Cells(lr + 2, 1) = Me.TextBox1.Text 6 Dim ws As Worksheet Dim lr As Long '--------------------------------------------- Set ws = ThisWorkbook.Sheets(1) '--------------------------------------------- lr = Cells(Rows.Count, "A").End(xlUp).Row - 1 ws.Cells(lr + 2, 1) = Me.TextBox1.Text '--------------------------------------------- وفي الأخير ملف مع التجميعية اتمنى ان تفيدكم خاصة للمبتدئين الترحيل من الفورم للشيت بعدة طرق.rar

بارك الله فيك أستاذي على هذا الكود الرائع إستفدت منه الكثير جعله الله في موازين حسناتك تحياتي لك

معذرة مني أخي الكريم لم أنتبه لردك شكرا وبارك الله فيك

تفضل اخي

قم بإدراج هذا الكود في الموديول Sub copy_past() Application.ScreenUpdating = False Range("B8:M31").Select Selection.Copy Sheets(2).Select Sheets(2).Name = "البيانات1" Range("B8").Select ActiveSheet.Paste Application.ScreenUpdating = True End Sub

أخي الكريم تفضل ما طلبته أولا قم بإنشاء زر تحكم وسمه مثلا cmd_1 وفي حدث الزر قم بإدراج الكود التالي Private Sub cmd_1_Click() With UserForm1 .Height = 380.25 .Left = 0 .Top = 2.25 .Width = 448.5 .Zoom = 100 .StartUpPosition = 2 - CenterOwner End With

استاذي إبراهيم ياريت شرح لهذا كود الترحيل Dim lr As Integer lr = [b1000].End(xlUp).Row Range("b2:d" & lr).Copy Range("l" & [l1000].End(xlUp).Row + 1) Range("b2:d" & lr).ClearContents MsgBox "تم الترحيل"

للرفع

هل فيه إمكانية تغيير الصفحات تلقائيا بدون معرفتي لواجهة للغة الاوفيس المستخدمة مثلا:الأوفيس واجهة عربية إفتراضيا أسماء الاوراق عربية ورقة1. ورقة 2 هل يمكن تغييرها للغة الإنجليزية عند فتح ملف الإكسل والعكس كذلك من اللغة الإنجليزية إلى العربية

أستاذي القدير /عبد الله باقشير بارك الله فيك على مرورك العطر وإثرائك للموضوع بهذا كود رائع جدا جزاك الله خيرا تقبل ودي وإحترامي

بارك الله فيك أستاذي الكريم / إبن مصر على سرعة الرد وعمل المطلوب جزيت خيرا هل فيه إمكانية تغيير الصفحات تلقائيا بدون معرفتي لواجهة للغة الاوفيس المستخدمة مثلا:الأوفيس واجهة عربية إفتراضيا أسماء الاوراق عربية ورقة1. ورقة 2 هل يمكن تغييرها للغة الإنجليزية عند فتح ملف الإكسل والعكس كذلك من اللغة الإنجليزية إلى العربية

السلام عليكم ورحمة الله تعالى وبركاته المطلوب في المرفق Sheet Reneme.rar

معذرة استاذي لم أنتبه لردك إلا بعد مشاركة الرد

في حدث زر ترحيل Cells(1, 1) = Me.TextBox1.Value

تم المطلوب بعد محاولات عدة الكود المرفق Dim j As Integer For j = 1 To 2 With Controls("ComboBox" & j) .AddItem "الفوج1" .AddItem "الفوج2" End With Next j

أخى الفاضل الجموعي استخدم الترقيم افضل اما رقم 1 او 2 .... أو من الممكن ان تستخدم اسماء الشيت نفسها Set GRHS = ThisWorkbook.Sheets("GRH") تحياتي بارك الله على المعلومة وزادك الله من علمه أردت إستبدال هذا الكود الخاص بالكمبوبوكس With ComboBox1 .AddItem "الفوج1" .AddItem "الفوج2" End With With ComboBox2 .AddItem "الفوج1" .AddItem "الفوج2" End With وأختصاره بالكود التالي Dim j As Integer For j = 1 To 2 Me.Controls("ComboBox" & j).AddItem "الفوج2", "الفوج1" Next j لم يعمل معي عمل معي عندما قمت بحذف الفوج الثاني يا ترى ما المشكلة أستاذي

اخى الفاضل الجموعي راجع الملف المرفق .. لربما به طلبك تحياتي بارك الله فيك وفي والديك أستاذي الفاضل مشكور على هذه التغطية للموضوع أثابك الله الجنة بالنسبة لكود التنقل بين الصفحات إستعملت هذا الكود في حدث كل زر ولم يفلح معي ما المشكل إذن: æÑÞÉ1.Select æÑÞÉ2.Select æÑÞÉ3.Select

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

أستاذي القدير بارك الله فيك أنا تاني تهت بهذه الاكواد عندما كانت كلها موضوعة داخل الفورم لهذا إلتجأت لتقسيمها لتسهيل عليا وعليكم العملية إذن ما المطلوب مني؟ إذا فيه أكواد بسيطة لعمل مثل ذلك أفدني بها. لأن العمل مزال متواصل أنا حاليا قطعت 90% الشيت الأول والشيت الثاني والثالث مزال نفس العملية كل شيت فيه جدولين مشكله بسيطه راح تواجهني فيما بعد: عندالضغط على زر BASE DE DONNEES يفعل الشيت 2 عندالضغط على زر RESEAUX يفعل الشيت 3 ============= نرجع لموضوعنا تم التعديل بنجاح لكن مشكلة أظن أنها بسيطه عندك عند إختيار الفوج الثاني: عند الحذف يتم الحذف بنجاح لكن يتم حذف الرقم في الصف نفسه من الجدول الأول مثال لوحذفنا إسم عادل 2 يتم الحذف بنجاح لكن يحذف معه الرقم فقط في الخلية A4 من الجدول الاول

للرفع

السلام عليكم ورحمة الله تعالى وبركاته وجهتني مشكله في زر حذف وزر حفظ التعديل زرالترحيل من الفورم للجدول الثاتي علما أن عملية البحث تكون تمام لكن عند الحذف او التعديل او ترحيل جديد كل البيانات ترحل للجدول الاول فورم بحث (تم الحفظ تلقائياً).rar

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

تم عمل المطلوب وهذا بفضل الأستاذ الفاضل /إبن مصر جزاه الله كل الخير قمت بوضع هذه الجزءية في حدث زر حذف وتمت العملية بنجاح row_no = Range("A65536").End(xlUp).Row r = 4 For X = 1 To row_no - 3 With ورقة1 .Cells(r, 1).Value = X r = r + 1 End With Next

أستاذي شكرا على المجهود الواضح أني لم أوصل لك الفكرة جيدا شاهد الصور ستفهم ما اقصده أريد الترقيم يبقى كما قبل الحذف وما الهدف من إضافة هذه الجزئية في حدث زر الترحيل For i = 1 To 1 For T = 4 To row_number If TextBox5.Text = ورقة1.Cells(T, 1) Then With ورقة1 .Cells(T, i).Value = "" .Range(Cells(T, 1), Cells(T, 6)).delete Shift:=xlUp Call delete End With End If Next Next row_no = Range("A65536").End(xlUp).Row r = 4 For X = 1 To row_no - 3 With ورقة1 .Cells(r, 1).Value = X r = r + 1 End With Next

أستاذي الفاضل /إبن مصر تعبتك معي في التعديل المفروض مهمتي انا بارك الله فيك وفي مساعيك نفس المشكل راجع ما كتبته في المشاركة 9