اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

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

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

 

  • Like 5
قام بنشر

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

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

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

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

  • Like 2
  • Thanks 1
قام بنشر

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

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

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

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

  • Like 2
  • 3 weeks later...
قام بنشر

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

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

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

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

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

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

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

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

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

 

 

  • 3 weeks later...

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information