كود ترحيل البيانات من صفحة الى عدة صفحات بتاريخ المدخلات

[hassan951]

عندى ملف الاكسل
المطلوب
الشيت الاول مسمى يومى اسجل فيها البيانات اليوميه
الشيت التالى مسمى ابريل 2 اى يعنى من 15 الى 30 ابريل
الشيت التالى مسمى مايو1 اى يعنى من 1الى 15مايو
وهكذا
اريد عمل زر فى الشيت (يومى ) بحيث عند ملء البيانات والضغط عليه

بيانات اليوم الى شيت التجميع ابريل2
اى يرحل البيانات الى شيت ابريل2 يوم 15 ابريل الذى هو يوم التسجيل
واليوم التالى 16 ابريل بعدما امسح البيانات واسجل جديد يوم 16
يرحلها الى ملف ابريل2 سطر يوم 16 وهكذا
وعندما ياتى يوم واحد مايو
يرحل فى 1 مايو وهكذاااااااااااااااااااا

واخر ملف يجمل كل المراحل معا بشكل اوتوماتيكى

فى شيت (اجمالى كلى)

هل هذا ممكن فى اكسل ولكم جزيل الشكر

عنوان مخالف... تم تعديل عنوان المشاركة ليعبر على طلبك

ترحيل من يومى لاسبوع او شهرى.xlsx

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

كل شيء ممكن في الاكسيل

1-تغيير اسماء الصفحات ليتعرف عليها الاكسل بشكل جيد من جهة ومن جهة ثانية اسهل في كتابة الكود ونسخه ولصقه

2-التاريخ في الخلية B15  يجب ان يكتب كتاريخ وليس تاريخ ومعه الحرف م

3- الخلايا المدمجة في الصف الأول لا أنصح بها (لانها تسبب مشاكل في تحديد اخر صف فيه بيانات)

4- اذا كان التاريخ خطأ  B15  تحصل على رسالة يذلك و يتوقف الكود عن العمل

الكود

Option Explicit
Sub tansform_data()
Dim B As Worksheet, Var_sh As Worksheet
Dim Jour%, Mois%, Last_row%
Dim Spec_rg As Range
Set B = Sheets("By_jour")
Set Spec_rg = B.Range("A15")

If Not IsDate(Spec_rg) Then
 MsgBox "You Enter a wrong Date Please Justify"
 Exit Sub
End If
 
 Jour = Day(Spec_rg): Mois = Month(Spec_rg)
 Select Case Mois
  Case 4
       Select Case Jour
        Case Is <= 15
        Set Var_sh = Sheets("Ap1")
        Case Else
        Set Var_sh = Sheets("Ap2")
       End Select
       '+++++++++++++++++++++++++++++
 Case 5
       Select Case Jour
        Case Is <= 15
        Set Var_sh = Sheets("May1")
        Case Else
        Set Var_sh = Sheets("May2")
       End Select
      '+++++++++++++++++++++++++++++
 Case 6
       Select Case Jour
        Case Is <= 15
        Set Var_sh = Sheets("Jun1")
        Case Else
       Set Var_sh = Sheets("Jun2")
       End Select
      '+++++++++++++++++++++++++++++
 Case 7
       Select Case Jour
        Case Is <= 15
        Set Var_sh = Sheets("Jul1")
        Case Else
       Set Var_sh = Sheets("Jul2")
       End Select
  Case Else
  Exit Sub
       
  End Select
'  Var_sh.Select
  Last_row = Var_sh.Range("a:a").Find("", after:=Var_sh.Range("a3")).Row
 Var_sh.Cells(Last_row, 2).Resize(, 8).Value = _
 B.Cells(12, 2).Resize(, 8).Value
 Var_sh.Cells(Last_row, 1) = Spec_rg
 
End Sub

الملف مرفق

Tarhil_Youmi.xlsm

[أحمد يوسف]

أستاذ hassan951

أين الضغط على الإعجاب لهذا العمل الرائع الذى توصل وقام بحل مشكلتك وطلبك ؟!!!💙