مطلوب كود ترحيل بمدى محدد

[a.kawkab]

لدى ملف اكسل مكون من صفحة بها ثلاث جداول كل جدول مكون من21 صف مطلوب كود ترحيل من الفورم للجداول الثلاثة بحيث عندما بصل الترحيل للصف 21 الاخير يتم وقف ترحيل البيانات ويعطبنى رسالة انتقل للجدول التالى مرفق الملف ارجو المساعدة ولكم فائق الاحترام

 https://www.4shared.com/rar/8P2J2L_lca/ss_online.html

رابط مباشر

https://dc703.4shared.com/download/8P2J2L_lca/ss_online.rar?tsid=20170818-154045-dda7e6b2&sbsr=68f731ffbf65840d7d2d8b40dcc38d279b5&bip=NDEuNDUuODIuMTE2&lgfp=2000

تم تعديل أغسطس 18, 2017 بواسطه a.kawkab

[ياسر خليل أبو البراء]

السلام عليكم أخي الكريم

بدايةً أهلاً بك في المنتدى ونورت بين إخوانك

ثانياً عند طرح موضوع يجب إرفاق الملف في المنتدى وليس على رابط خارجي

ثالثاُ الملف المرفق في الرابط الخارجي ملف محبط واعذرني لصراحتي .. حيث وجدت حجم الملف كبير جداً حوالي (11.7 ميجا) ، فاعتقدت في البداية أن هناك أوراق عمل أخرى أو أوراق عمل مخفية ، ولكني فوجئت بورقة عمل واحدة فقلت لابد أن هناك صفوف أو أعمدة مخفية وبها بيانات ولكن وجدت فقط النطاق المستخدم  إلى الصف رقم 21 ...

فعملت أن هناك تنسيقات غير ضرورية وبالفعل وجدت أن الجدول الأول على سبيل المثال ممتد لآخر صف وهذا أمر مهلك وهو ما جعل الملف بهذا الحجم .. فكان لابد من حذف الصفوف الغير ضرورية في الجدول عن طريق تحديد صفوف الجدول بدايةً من الصف رقم 22 إلى آخر الصفوف ثم حذفها .. لابد أن تقوم بذلك بنفسك .. 

المهم قم بوضع الكود التالي في حدث الفورم وجرب بنفسك 

Private Sub CommandButton1_Click()
    Dim ws      As Worksheet
    Dim xf      As Variant
    Dim lr      As Integer

    Set ws = Sheets("ss")
    If Me.TextBox1.Value = "" Then MsgBox "Please Enter Name": Exit Sub
    If Me.TextBox2.Value = "" Then MsgBox "Please Enter Salary": Exit Sub
    If Me.ComboBox1.Value = "" Then MsgBox "Please Enter Statement": Exit Sub

    xf = Application.Match(ComboBox1.Value, ws.Rows(1), 0)

    If IsNumeric(xf) Then
        lr = ws.Cells(21, xf).End(xlUp).Row
        If lr = 2 Then MsgBox "This Is The Last Row", vbExclamation: Exit Sub

        ws.Cells(lr + 1, xf).Value = TextBox1.Value
        ws.Cells(lr + 1, xf + 1).Value = TextBox2.Value
        
        Call Reset_UserForm_Controls
    End If
End Sub

Private Sub CommandButton2_Click()
    Unload Me
End Sub

Sub Reset_UserForm_Controls()
    Dim c       As Control

    For Each c In Me.Controls
        Select Case TypeName(c)
            Case "TextBox"
                c.Text = vbNullString
            Case "ListBox", "ComboBox"
                c.ListIndex = -1
        End Select
    Next c
    TextBox1.SetFocus
End Sub

 

[a.kawkab]

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

بيان1.rar