نقل بيانات من صفحة لأخرى

[مستر أيسم]

لدي ملف به بيانات كثيرة متغيرة

أريد نقل صف البيانات بتاءا على متغير يكتب في عمود محدد

ثم مسح صف البيانات المنقولة و الاحتفاظ بها في الصفحة الجديدة

ترحيل.rar

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

جرب هذا الكود

Option Explicit

Sub from_sheet_to_other()
Dim D As Worksheet
Dim T As Worksheet
Dim F_rg As Range
Dim Cret$
Application.ScreenUpdating = False
Set D = Sheets("Data")
Set T = Sheets("target")
T.Range("A5").CurrentRegion.Clear
Set F_rg = D.Range("A5").CurrentRegion
Cret = "محول من المدرسة"

F_rg.AutoFilter 6, Cret
F_rg.SpecialCells(12).Copy _
T.Range("A5")

If D.AutoFilterMode Then _
 D.Range("A5").AutoFilter
 Application.ScreenUpdating = True
End Sub

الملف مرفق

Aysam.xlsm

[مستر أيسم]

طبعا الكود رائع و خفيف جدا

و لكن

أريد أن يحذف ما تم نقله من صفحة المصدر ( data )

و أن يبقى على ما تم نقله في صفحة  ( target )

و لو استخدمنا الكود مرة جديدة يبقى على ما تم نقله سابقا و يضيف ما تم نقله حديثا أسفل منه

أتمنى أن أكون وضحت المطلوب

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

تم التعديل على الماكرو كما تريد

Option Explicit

Sub from_sheet_to_other()
    Dim D As Worksheet
    Dim t As Worksheet
    Dim F_rg As Range
    Dim Cret$, Rot%, Rod%, m%
Application.ScreenUpdating = False
    Set D = Sheets("Data")
    Set t = Sheets("target")
 
 If D.AutoFilterMode Then _
 D.Range("A5").AutoFilter

Rot = t.Cells(Rows.Count, 1).End(3).Row
Rot = IIf(Rot < 6, 6, Rot + 1)
Rod = D.Cells(Rows.Count, 1).End(3).Row
Set F_rg = D.Range("A5:F" & Rod)
Cret = "محول من المدرسة"

F_rg.AutoFilter 6, Cret

On Error Resume Next
    D.Range("A6:F" & Rod).SpecialCells(12).Copy _
    t.Range("A" & Rot)
    D.Range("A6:F" & Rod).SpecialCells(12).EntireRow.Delete
On Error GoTo 0

If D.AutoFilterMode Then _
 D.Range("A5").AutoFilter
 Application.ScreenUpdating = True
End Sub

 

Aysam_1.xlsm

[مستر أيسم]

السلام عليكم

وجدت صعوبة في نقل الكود إلى ملفي.. فهل تتكرم علي أستاذ سليم بعمل التعديلات اللازمة

أول صف  للبيانات عندي هو  صف 8  و ليس صف 6

العمود الذي به كلمة" محول من المدرسة " هو العمود K  و ليس العمود F

السطر التالي من الكود يحذف الصف بأكمله

المطلوب أن يحذف المدي (A:L) فقط و يرفع الخلايا لأعلى

شكرا جزيلا