ترحيل بيانات حسب نوع العملية

[هشام كمال]

الاخوة خبراء الاكسل المطلوب داخل الشيت برجاء عمل اللازم

Book1.rar

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

جرب هذا الكود

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
  If Target.Address = "$K$4" And Target.Count = 1 Then
     get_data
  End If
Application.EnableEvents = True
End Sub
'++++++++++++++++++++++++++++++++
Sub get_data()
Dim T As Worksheet, Mb As Worksheet, Msh As Worksheet
Dim Opt_sh As Worksheet
Dim Str$, Ro_T%, Opt_ro%
Set T = Sheets("Tarhil")
Set Mb = Sheets("Mab")
Set Msh = Sheets("Moush")
Str = T.Cells(4, "K")
  Select Case Str
    Case "المبيعات": Set Opt_sh = Mb
    Case "المشتريات": Set Opt_sh = Msh
    Case Else: Exit Sub
  End Select
 Opt_ro = Opt_sh.Cells(Rows.Count, 1).End(3).Row
 Opt_ro = IIf(Opt_ro = 3, 4, Opt_ro + 2)
 Ro_T = T.Range("b9").CurrentRegion.Rows.Count
 If Ro_T > 1 Then
    Opt_sh.Range("A" & Opt_ro).Resize(Ro_T - 1, 12).Value = _
    T.Range("b10").Resize(Ro_T - 1, 12).Value
  Else
  MsgBox "No data to transfer"
    Exit Sub
 End If

End Sub
'=================================
Sub clear_all_Mab()
 Sheets("Mab").Range("A3").CurrentRegion.Offset(1).Clear
End Sub
'=================================
Sub clear_all_Moush()
 Sheets("Moush").Range("A3").CurrentRegion.Offset(1).Clear
End Sub

الملف مرفق

Book_sal.xlsm

[My eccnw]

جزاكم الله عنا كل  الخير 

 

[هشام كمال]

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

 

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

الكود يرحل عندما تغير شيئاً في الخلية k4 فقط

الازار وضعت اذا كنت تريد ان تفرغ اي شيت من الشيتات( اختيارياً)

 

[هشام كمال]

تسلم رائع جدا وجزاكم الله خير الجزاء اريد اضافة هل ممكن عمل رسالة تفيد بالترحيل حتى لا يتم التكرار ولاتلافي عملية التكرار لانه يقوم بالتكرار وهذا قد يسبب اخطاء كذلك اريد اضافة مردودات المشتريات ومردودات المبيعات ومتحصلات النقدية ومدفوعات حسب المرفق ولكم جزيل الشكر والتقدير لشخصكم الكريم حيث أنني حينما قمت بتجربة النموذج السابق اعجبني جدا فكرته فاطمع في التعديل على الباقي

Book1.xlsx

تم تعديل فبراير 12, 2020 بواسطه هشام كمال

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

لا اعمل مع ملف مسماتة شيتاته باللغة العربية( اكثر من مرة ذكرت ذلك)

غير اسماء الصفحات الى اللغة الاجنبية و سأحاول المساعدة

[هشام كمال]

الملف من جديد

Book1.xlsx