مشكلة في امر الترحيل

[طارق نادر]

السلام عليكم 

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

Private Sub CommandButton11_Click()
Dim SH As Worksheet
Set SH = ThisWorkbook.Sheets("المدراء (2)")
Workbooks.Application.Visible = True
Application.ScreenUpdating = False
With SH
.Activate
.[b4].Value = TextBox2.Value
.[c4].Value = TextBox3.Value
.[d4].Value = TextBox4.Value
.[e4].Value = TextBox5.Value
.[f4].Value = TextBox6.Value
.[g4].Value = TextBox7.Value
.[h4].Value = TextBox8.Value
.[i4].Value = TextBox9.Value
.[j4].Value = TextBox10.Value
.[k4].Value = TextBox11.Value
.[l4].Value = TextBox12.Value
.[m4].Value = TextBox13.Value
.[n4].Value = TextBox14.Value
.[o4].Value = TextBox15.Value
.[p4].Value = TextBox16.Value
.[q4].Value = TextBox17.Value

End With
Application.ScreenUpdating = True
End Sub

 

[ابو علي و سدرة]

استبدل الكود بالكود التالى

Private Sub CommandButton11_Click()
Dim SH As Worksheet
dim x as long
Set SH = ThisWorkbook.Sheets("المدراء (2)")
x = SH.Cells(Rows.Count, 1) _
  .End(xlUp).Offset(1, 0).Row

Workbooks.Application.Visible = True
Application.ScreenUpdating = False
SH.Cells(x, 2).Value = Me.textBox2.Value
SH.Cells(x, 3).Value = Me.textBox3.Value
SH.Cells(x, 4).Value = Me.textBox4.Value
SH.Cells(x, 5).Value = Me.textBox5.Value
SH.Cells(x, 6).Value = Me.textBox6.Value
SH.Cells(x, 7).Value = Me.textBox7.Value
SH.Cells(x, 8).Value = Me.textBox8.Value
SH.Cells(x, 9).Value = Me.textBox9.Value
SH.Cells(x, 10).Value = Me.textBox10.Value
SH.Cells(x, 11).Value = Me.textBox11.Value
SH.Cells(x, 12).Value = Me.textBox12.Value
SH.Cells(x, 13).Value = Me.textBox13.Value
SH.Cells(x, 14).Value = Me.textBox14.Value
SH.Cells(x, 15).Value = Me.textBox15.Value
SH.Cells(x, 16).Value = Me.textBox16.Value
SH.Cells(x, 17).Value = Me.textBox17.Value
Application.ScreenUpdating = True
End Sub

باذن الله سيعمل معك تمام

[طارق نادر]

اخي الكريم نفس المشكلة بقيت البيانات تنسخ بعضها في نفس الصف ولا تنتقل المعلومات الجديدة الى الصف الذي يليه

تم تعديل أبريل 23, 2017 بواسطه n_tareq

[سليم حاصبيا]

جرب هذا الكود

Private Sub CommandButton11_Click()
Dim SH As Worksheet
Set SH = ThisWorkbook.Sheets("المدراء (2)")
Workbooks.Application.Visible = True
Application.ScreenUpdating = False

x = SH.Cells(Rows.Count, 2).End(3).Row + 1
Set my_rg = SH.Range("b" & x).Resize(1, 16)

For i = 1 To my_rg.Count
  my_rg.Cells(i) = Me.Controls("TextBox" & i + 1).Value
 Next

Application.ScreenUpdating = True
End Sub

 

[طارق نادر]

كل الشكر 100% احترامي لك اخي الكريم والى اخي ابو علي