مطلوب كود ترحيل البيانات للضروره

[علي حيدر]

المطلوب :كود  ادخال و ترحيل البيانات الموجودة في الورقة الاساسية (00)الى اوراق العمل حسب التاريخ المدخل في الفورم الاساسي بحيث يتم حفظ بيانات شهر يناير في الشيت الخاص بشهر يناير مع مرعات عدم مسح البيانات من ورقة العمل الرئيسية

الساده أعضاء المنتدى ملوك الترحيل احبائي اين انتم  رجاء

الملف مرفق

اليوميه الامريكية.rar

[علي حيدر]

هل من رد اخواني الرجاء المساعدة 

[علي حيدر]

اخواني الأعضاء الأساتذة الافاضل لا احد يمكنه الرد هل يلزمني مزيداً من الصبر او انه صعب و لا يوجد حل للادخال والترحيل لكم تحياتي

[ياسر العربى]

تفضل 

المزيد من الصبر اخي الكريم 

تقبل تحياتي

 

اليوميه الامريكية.rar

[علي حيدر]

الله عليك يا كبير جزاك الله خيرا سلم الله يداك مشكور وهذاهو المطلوب تقبل تحياتي

[ياسر العربى]

جزيت خيرا 

تفضل كود الترحيل شامل الصفحة الرئيسية وصفحة الشهر معا

واقل في عدد الاسطر

Private Sub ComdBFixedAst1_Click()
    Dim LastRow As Long, arr(), arry(), xx As String, I As Long
    arr = Array(Lbl1.Caption, Textbox2.Text, Textbox1.Text, Textbox4.Text, Combobox1.Text, Textbox5.Text, Combobox2.Text, Textbox3.Text)
    arry = Array("Textbox2", "Textbox1", "Textbox4", "Combobox1", "Textbox5", "Combobox2", "Textbox3", "Textbox3")
    LastRow = Sheets("00").Range("b" & Rows.Count).End(xlUp).Row + 1
    xx = Month(Textbox1.Text)
    lr = Sheets(xx).Range("b" & Rows.Count).End(xlUp).Row + 1
    For I = 2 To 9
        Sheets("00").Cells(LastRow, I) = arr(I - 2)
        Sheets(xx).Cells(lr, I) = arr(I - 2)
        Me.Controls(arry(I - 2)).Value = ""
    Next
    Lbl1.Caption = Lbl1.Caption + 1
    On Error GoTo EERR
EERR:
    Call FIX1ZZZNR
End Sub

 

[علي حيدر]

شكرا لك اخي جزاك الله خيرا