كود لترحيل البيانات المفلتره فقط ؟؟

[ليمونة الحلوة]

السلام عليكم 

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

وشكرا سلفاً

ترحيل.xlsm

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

هذا الماكرو يقوم بما تريدين اختي الفاضلة

Option Explicit
Sub lena()
If Sheets(1).[c4] = vbNullString Then Exit Sub
Dim lr%, lr1%
 lr = Range("a" & Rows.Count).End(xlUp).Row
  If lr <= 5 Then
    MsgBox "No Data to Transfer", 64
    Exit Sub
  End If
 lr1 = Sheets(Sheets(1).[c4].Value) _
  .Cells(Rows.Count, 1).End(3).Row + 2
   Sheets(1).Range("a6").Resize(lr - 5, 14) _
  .Cut Sheets(Sheets(1).[c4].Value).Range("a" & lr1)

End Sub

 

[Ali Mohamed Ali]

بارك الله فيك استاذ سليم

[أحمد يوسف]

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

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

بمعنى الضغط له على الإعجاب او الشكر واعتقد ان هذا هو اقل ما تقدمه له

بارك الله فيكم جميعا اساتذتنا الكرام لكم الفضل بعد ربنا فى تعلمنا الإكسيل جعل الله كل هذه الأعمال فى ميزان حسناتكم

[ليمونة الحلوة]

شكرأ لمجهودك أخي سليم 

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

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

تم معالجة الأمر

الماكرو لا يعمل اذا لم يكن الفلتر موجوداً أو اذا لم تكن الورقة الاولى هي النّاشطة

بعد تنفيذ الماكرو تمسح البيانات التي تم نقلها من الورقة الاولى

Sub Salim()
If ActiveSheet.Name <> "Sheet1" Or _
Sheets("sheet1").AutoFilterMode = False Then Exit Sub
If Sheets(1).[c4] = vbNullString Then Exit Sub
Dim lr%, lr1%
 lr = Sheets(1).Range("a" & Rows.Count).End(xlUp).Row
  If lr <= 5 Then
    MsgBox "No Data to Transfer", 64
    Exit Sub
  End If
 lr1 = Sheets(Sheets(1).[c4].Value) _
  .Cells(Rows.Count, 1).End(3).Row + 2
  If lr1 = 7 Then lr1 = 6
   Sheets(1).Range("a6").Resize(lr - 5, 14).SpecialCells(12) _
  .Cut Sheets(Sheets(1).[c4].Value).Range("a" & lr1)
  Sheets(1).Range("a6").Resize(lr - 5, 14).SpecialCells(4).EntireRow.Delete
Sheets("sheet1").AutoFilterMode = False
End Sub

الملف من جديد

 

Tarhil_by_filter.xlsm

[ليمونة الحلوة]

يظهر لي الخطأ 400 

عند أختار خلايا متسلسل يقوم بالترحيل (B6- B7-B8) يقوم بالترحيل

في حال اخترت خلايا عشوائية (B6-B9-B13 ) يظهر لي الخطأ 400

وشكرأ لمجهودك وتعاونك سليم 

ترحيل.rar

[ليمونة الحلوة]

يظهر لي الخطأ 400 

عند أختار خلايا متسلسل يقوم بالترحيل (B6- B7-B8) يقوم بالترحيل

في حال اخترت خلايا عشوائية (B6-B9-B13 ) يظهر لي الخطأ 400

وشكرأ لمجهودك وتعاونك سليم 

Just now, ليمونة الحلوة said:

يظهر لي الخطأ 400 

عند أختار خلايا متسلسل يقوم بالترحيل (B6- B7-B8) يقوم بالترحيل

في حال اخترت خلايا عشوائية (B6-B9-B13 ) يظهر لي الخطأ 400

وشكرأ لمجهودك وتعاونك سليم 

 

 

[ليمونة الحلوة]

أرجووووووو المساعدة في الخطأ 400