اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

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

 

سؤال أين الخلل  في ترحيل البيانات من من الفورم الى شيت كسال VBA

ترحيل البيانات في الأعمدة excel

الاليس في مكانها  مثل عمود "A"صف 17

 ترحيل البيانات في الأعمدة excel ":

259969946.png

Code-VBA:

683223580.png

 

 

 

هنا ملف 

محضر التقييم النهائي.xlsm

قام بنشر

وعليكم السلام ورحمه الله

اولاً الصوره المرفقه مش وضحه ولكن جرب الكود التالي

On Error Resume Next
Dim last As Long

last = Sheet1.Range("B90").End(xlUp).Row + 1

Sheet1.Cells(last, "B").Value = Me.TextBox2.Value ' الرقم التعريفي
Sheet1.Cells(last, "C").Value = Me.TextBox15.Value 'الرقم التسجيل
Sheet1.Cells(last, "E").Value = Me.TextBox8.Value ' اللقب
Sheet1.Cells(last, "D").Value = Me.TextBox16.Value 'الاسم
Sheet1.Cells(last, "G").Value = Me.TextBox10.Value 'مكان الميلاد
Sheet1.Cells(last, "F").Value = Me.TextBox11.Value 'تاريخ الميلاد
Sheet1.Cells(last, "AE").Value = Me.TextBox9.Value 'اللقب بالاتننية
Sheet1.Cells(last, "AF").Value = Me.TextBox17.Value 'الاسم بالاتننية
Sheet1.Cells(last, "AG").Value = Me.TextBox18.Value 'مكان الميلاد بالاتننية
Sheet1.Cells(last, "AH").Value = Me.TextBox19.Value 'ولاية
Sheet1.Cells(last, "AC").Value = Me.TextBox12.Value 'تخصص
Sheet1.Cells(last, "AD").Value = Me.TextBox20.Value 'تخصص بالاتننية
Sheet1.Cells(last, "AL").Value = Me.TextBox13.Value ' رقم الوسيط
Sheet1.Cells(last, "AJ").Value = Me.TextBox21.Value ' رقم هاتف

MsgBox "تم ترحيل البيانات بنجاح", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "تأكيد"

Me.TextBox2.Value = ""
Me.TextBox15.Value = ""
Me.TextBox16.Value = ""
Me.TextBox8.Value = ""
Me.TextBox10.Value = ""
Me.TextBox11.Value = ""
Me.TextBox9.Value = ""
Me.TextBox17.Value = ""
Me.TextBox18.Value = ""
Me.TextBox19.Value = ""
Me.TextBox12.Value = ""
Me.TextBox20.Value = ""
Me.TextBox13.Value = ""
Me.TextBox21.Value = ""
ThisWorkbook.Save

 

قام بنشر

اخي ملفك مليئ بالاخطاء وغير منظم لاكنني ساقوم باصلاح كود الترحيل فقط  على حسب طلبك  بنفس طريقة اشتغالك 

قم بوضع الكود هكدا .

Private Sub CmdADD_Click()
Dim last As Long
If Me.TextBox2 = Empty Then: Exit Sub
With sheet1
last = .Cells(.Rows.Count, "b").End(xlUp).Offset(1, 0).Row
 sheet1.Cells(last, "B").Value = Me.TextBox2.Value ' الرقم التعريفي
 sheet1.Cells(last, "C").Value = Me.TextBox15.Value 'الرقم التسجيل
 sheet1.Cells(last, "E").Value = Me.TextBox8.Value ' اللقب
 sheet1.Cells(last, "D").Value = Me.TextBox16.Value 'الاسم
 sheet1.Cells(last, "G").Value = Me.TextBox10.Value 'مكان الميلاد
 sheet1.Cells(last, "F").Value = Me.TextBox11.Value 'تاريخ الميلاد
 sheet1.Cells(last, "AE").Value = Me.TextBox9.Value 'اللقب بالاتننية
 sheet1.Cells(last, "AF").Value = Me.TextBox17.Value 'الاسم بالاتننية
 sheet1.Cells(last, "AG").Value = Me.TextBox18.Value 'مكان الميلاد بالاتننية
 sheet1.Cells(last, "AH").Value = Me.TextBox19.Value 'ولاية
 sheet1.Cells(last, "AC").Value = Me.TextBox12.Value 'تخصص
 sheet1.Cells(last, "AD").Value = Me.TextBox20.Value 'تخصص بالاتننية
 sheet1.Cells(last, "AI").Value = Me.TextBox13.Value ' رقم الوسيط
 sheet1.Cells(last, "AJ").Value = Me.TextBox21.Value ' رقم هاتف
End With

Me.TextBox2.Value = ""
Me.TextBox15.Value = ""
Me.TextBox16.Value = ""
Me.TextBox8.Value = ""
Me.TextBox10.Value = ""
Me.TextBox11.Value = ""
Me.TextBox9.Value = ""
Me.TextBox17.Value = ""
Me.TextBox18.Value = ""
Me.TextBox19.Value = ""
Me.TextBox12.Value = ""
Me.TextBox20.Value = ""
Me.TextBox13.Value = ""
Me.TextBox21.Value = ""
MsgBox "تم ترحيل البيانات بنجاح", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "تأكيد"

ThisWorkbook.Save


End Sub

 

  • Like 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information