Ahmed Saad 2017 قام بنشر مايو 29, 2019 مشاركة قام بنشر مايو 29, 2019 السادة الزملاء المحترمين برجاء المساعدة في انشاء كود فلترة و انشاء شيت جديد للبيانات بحيث انه يتم عمل فلتر علي العمود A ثم يتم انشاء جديد وليس تاب بأسم الرو و ترحيل الداتا المفلترة الي الشيت الجديد مرفق الشيت Copy of New Microsoft Excel Worksheet (13).xlsx رابط هذا التعليق شارك More sharing options...
أفضل إجابة سليم حاصبيا قام بنشر مايو 29, 2019 أفضل إجابة مشاركة قام بنشر مايو 29, 2019 حرب هذا الكود يأخذ وقتاً بعض الشيء لان البيانات كثيرة حوالي 20 الف صف مع خلق صفحات جديدة اذا لم تكن موجودة مسبقاً Option Explicit Sub Get_More_sheets() Dim my_arr() Dim LrMM%, i%, x% Application.ScreenUpdating = False With Sheets("Sheet1") If .FilterMode Then .ShowAllData .Range("a1").AutoFilter End If End With Sheets("Sheet1").Range("a2", Range("a1").End(4)).Copy _ Sheets("Sheet1").Range("MM1") LrMM = Cells(Rows.Count, "MM").End(3).Row Sheets("Sheet1").Range("MM1:MM" & LrMM). _ RemoveDuplicates Columns:=1 LrMM = Cells(Rows.Count, "MM").End(3).Row ReDim my_arr(1 To LrMM) For i = 1 To LrMM my_arr(i) = Range("MM" & i) Next Sheets("Sheet1").Range("MM1:MM" & LrMM).Clear On Error Resume Next For i = 1 To LrMM x = Len(Sheets(my_arr(i)).Name) If x = 0 Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = my_arr(i) End If Next Sheets("sheet1").Activate On Error GoTo 0 For i = 1 To LrMM With Sheets("Sheet1").Range("a1").CurrentRegion .AutoFilter Field:=1, Criteria1:=my_arr(i) .SpecialCells(12).Copy _ Sheets(my_arr(i)).Range("A1") Sheets(my_arr(i)).Columns("A:B").AutoFit End With Next With Sheets("Sheet1") If .FilterMode Then .ShowAllData .Range("a1").AutoFilter End If End With MsgBox "That Is All" & Chr(10) & _ "Thank You ====> Salim" Application.ScreenUpdating = True End Sub الملف مرفق GET_sheets.xlsm 2 رابط هذا التعليق شارك More sharing options...
وجيه شرف الدين قام بنشر مايو 29, 2019 مشاركة قام بنشر مايو 29, 2019 الله عليك استاذ سليم روعة رابط هذا التعليق شارك More sharing options...
Ahmed Saad 2017 قام بنشر مايو 29, 2019 الكاتب مشاركة قام بنشر مايو 29, 2019 بشكر حضرتك علي المساعدة بس انا محتاج ان الكود ينشأ ملف عمل جديد بأسم الفلتر و ليس شيت جديد في ورقة العمل فبرجاء لو في حل آخر تساعدنا بيه Copy of New Microsoft Excel Worksheet (13).xlsx رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان