كود ترحيل من خلال الفورم

[osama elmorsy]

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

Daily.xlsm

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

مع اني لا أحب اليوزر فورم ولا أطيق التعامل معه

بالاضافة الى اني لا أحب تسمية الاوراق ياللغة العربية(Youmia)

الكود من اليوزر االى الشيت

 

Dim Y As Worksheet
Dim Arr_From()
Dim Arr_To()
Dim Ar_range()
'++++++++++++++++++++++++++++++++++++++++++++++
Private Sub cmd_toSheet_Click()
Dim i%, How_many%, Bool As Boolean
Dim k%
Set Y = Sheets("Youmia")
 Ar_range = Array("B8", "B47", "B86")
 Arr_From = Array("TB", "TC", "TD" _
            , "TE", "TG", "TF", "TH")
 Arr_To = Array("B", "C", "D", _
            "E", "G", "F", "H")
'      For i = LBound(Arr_From) To UBound(Arr_From)
'       Me.Controls(Arr_From(i)) = Chr(Application.RandBetween(65, 90))
'      Next
            
       For i = LBound(Arr_From) To UBound(Arr_From)
       If Me.Controls(Arr_From(i)) = vbNullString Then
         MsgBox "Empty TextBox "
         Exit Sub
       End If
      Next
   
   For i = 0 To 2
     How_many = Application.CountA(Y.Range(Ar_range(i)).Resize(30))
      Bool = IIf(How_many = 30, True, False)
      If Not Bool Then Exit For
   Next
   
   With Y.Range(Ar_range(i)).Cells(1).Offset(How_many)
    For k = LBound(Arr_From) To UBound(Arr_From)
     .Offset(, k) = Me.Controls(Arr_From(k))
    Next
  End With
End Sub

 

Osama_User.xlsm

[osama elmorsy]

الأستاذ المبدع الرااااااائع جدا أستاذ سليم تعجز الكلمات عن الشكر والله أنت أنسان مبدع فوق الوصف ربنا يباركلك 
وجاري تغيير اسم ورقة العمل من يومية لشيئ اخر