ترحيل بيانات ومسحها بشرط

[asd2000]

يعطيكم العافيه 

مرفق لكم جدول فيه ورقتين اتمني ان يتم ترحيل البيانات من الورقه 1 الي الورقه2 وذلك حسب الشرط اللي امام كل صف  مرفق لكم الحل المطلوب في المرفق

وبعد الترحيل تحذف البيانات المرحله في الورقه 1

ع.xlsx

[أ / محمد صالح]

يمكنك استعمال هذا الكود للتصفية أولا ثم النسخ ثم الحذف

Sub copy_filtered_data()
If Evaluate("=COUNTIF(I:I,""جاهز"")") > 0 Then
Application.ScreenUpdating = 0
Dim lr1 As Long, lr2 As Long
lr1 = Sheet1.Cells(Rows.Count, 1).End(3).Row
lr2 = Sheet2.Cells(Rows.Count, 1).End(3).Row + 1
Sheet1.Range("$A$1:$I$" & lr1).AutoFilter Field:=9, Criteria1:="جاهز"
Sheet1.Range("a2:i" & lr1).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("A" & lr2)
Sheet1.Range("a2:i" & lr1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Sheet1.Range("$A$1:$I$" & lr1).AutoFilter
Application.ScreenUpdating = 1
MsgBox "done by mr-mas.com"
Else
MsgBox "لا يوجد صفوف جاهزة لترحيلها"
End If
End Sub

وهذا ملفك بعد وضع الكود وتغيير الامتداد (لأن معظم الأوقات يكون صاحب الاستفسار لا يعرف كيفية التعامل مع أساسيات الأكواد)

بالتوفيق 

 

 

نسخ البيانات بعد الفلتر.xlsb

[0d59eacf59]

يعطيك العافية 

 

 

 

 

 

 

 

 

 

 

 

Tutuapp 9Apps Showbox

[أ / محمد صالح]

جميعا بإذن الله تعالى