2saad قام بنشر يوليو 4 مشاركة قام بنشر يوليو 4 اخواني الأعزاء تحية طيبة وبعد محتاج كود لترتيب الذكور أولا وبعدها الإناث وكود يرحل الذكور في ورقة عمل والإناث في ورقة أخري الملف المرفقتقرير صف أول 2025.xlsm رابط هذا التعليق شارك More sharing options...
أفضل إجابة محمد هشام. قام بنشر يوليو 4 أفضل إجابة مشاركة قام بنشر يوليو 4 (معدل) وعليكم السلام ورحمة الله تعالى وبركاته Option Compare Text Public Property Get F() As Worksheet: Set F = Worksheets("Sheet1") End Property Sub Sort_Category() Dim OneRng As Range Dim lr As Long lr = F.Cells(Rows.Count, "E").End(xlUp).Row Set OneRng = F.Range("A2:L" & lr) With OneRng .Sort Key1:=.Columns(5), Order1:=xlDescending, Header:=xlNo End With End Sub '***************************** Sub Filter_and_create_Sheets() Application.DisplayAlerts = False Application.ScreenUpdating = False F.[w1] = F.[E1] RngA = F.[A1].CurrentRegion.Rows.Count RngB = F.[A1].CurrentRegion.Columns.Count F.[A1].Resize(RngA, RngB).AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=F.[w1], Unique:=True For Each c In F.Range("W2:W" & F.[W65000].End(xlUp).Row) F.[W2] = c.Value On Error Resume Next Sheets(CStr(c.Value)).Delete On Error GoTo 0 Sheets.Add After:=Sheets(Sheets.Count) Set n = ActiveSheet n.Name = CStr(c.Value) n.DisplayRightToLeft = True F.[A1].Resize(RngA, RngB).AdvancedFilter Action:=xlFilterCopy _ , CriteriaRange:=F.[W1:W2], CopyToRange:=[A1] For r = 1 To 12 n.Cells.EntireRow.AutoFit n.Columns(r).ColumnWidth = F.Columns(r).ColumnWidth Application.ErrorCheckingOptions.NumberAsText = False Next Next c F.Activate End Sub تقرير صف أول 2025.xlsm تم تعديل يوليو 5 بواسطه محمد هشام. 4 رابط هذا التعليق شارك More sharing options...
2saad قام بنشر يوليو 5 الكاتب مشاركة قام بنشر يوليو 5 بارك الله فيك أخي الاستاذ محمد وزادك الله من علمه رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان