المساعدة فى حل مشكلة ترحيل بيانات

[amr_ha2003]

السلام عليكم 

ارجوا المساعدة فى عمل ترحيل لبعض البيانات حسب شرط معين كما بالمرفقات 

وشكرا 

Book2.xlsx

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

جرب هذا الملف

amr.xlsx

[amr_ha2003]

جزاك الله خير 

بعتذر هل هناك طريقة لنقل البيانات من الشيت الاساسي الى نوع القضية 

بمعني الغاء البيانات من الشيت الاساسي ونقلها الى الشيت الاخر 

وشكرا 

 

[Mohamed_Fouad]

عليكم السلام 

تفضل يا اخى 

اتمنى ان اكون فهمت طلبك كما يجب

ترحيل بناء على نوع القضية.xlsm

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

بعد اذن الاخ محمد

عمليات   الــــ  Copy و الـــ Paste ترهق البرنامج دون اي فائدة (قدر الامكان الابتعاد عتها خاصة في حالة البيانات الكثيرة)

Sub Distrebute_data()

Dim lr As Long, M As Long
Dim Sh As Worksheet, i%, x%, But_Sheet$
Dim AAM  As Worksheet
Set AAM = Sheets("عام")

lr = AAM.Cells(Rows.Count, "A").End(xlUp).Row
If lr < 3 Then Exit Sub
i = 3
    Do Until i = lr + 1
        On Error Resume Next
        But_Sheet = AAM.Cells(i, "G")
        Set Sh = Sheets(But_Sheet)
        If Err.Number = 0 Then
          x = Sh.Cells(Rows.Count, "A").End(xlUp).Row + 1
          Sh.Cells(x, 1).Resize(, 9).Value = _
          AAM.Cells(i, "a").Resize(, 9).Value
        End If
        Error.Clear
       i = i + 1
    Loop
 AAM.Cells(3, 1).Resize(lr, 9).ClearContents
End Sub

 

[amr_ha2003]

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