السلام عليكم
تم التوصل الى الكود باقتباس من احد اعمال العلامة خبور
تم رفع الشيت بالكود للاستفادة وشكرا لكم
Private Sub CommandButton1_Click()
' أمر ترحيل بيانات
Dim LR As Long
Dim Adr As String
Dim r As Integer, c As Integer
'''''''''''''''''''''''''''''''
With Sh1
LR = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
''''''''''
For r = 1 To 10
Adr = Cells(r, 1).Address(0, 0)
For c = 1 To 5
Adr = Cells(r, c).Address(0, 0)
Sh1.Range("A" & LR).Cells(r, c).Value = Me.Controls(Adr).Value
Next
Next
''''''
End Sub
Book101Add.xlsm