فرز كل 20 صف مع جمع بعض الخلايا

[عبدالله صباح]

السلام عليكم

عندي ملف يحتوي على بيانات كثيرة

ممكن فرز كل 20 صف مع جمع بعض الخلايا

جزيتم خيرا

جمع كل 20 صف.xlsm

[lionheart]

Rename the data sheet to Data and create another sheet and name it Result OR change the sheet names in the code

Sub Test()
    Const lRows As Long = 20, lCols As Long = 13
    Dim ws As Worksheet, sh As Worksheet, rHeaders As Range, r As Long, lr As Long, m As Long
    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Worksheets("Data")
        Set sh = ThisWorkbook.Worksheets("Result")
        sh.Cells.Clear
        Set rHeaders = ws.Range("A1:M1")
        lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
        For r = 2 To lr Step lRows
            m = sh.Cells(Rows.Count, "H").End(xlUp).Row + 1
            m = IIf(m = 2, 1, m)
            rHeaders.Copy sh.Range("A" & m)
            With sh.Range("I" & m)
                .Interior.Color = vbYellow
                .Offset(, 2).Interior.Color = vbYellow
            End With
            ws.Range("A" & r).Resize(lRows, lCols).Copy sh.Range("A" & m + 1)
            With sh.Range("H" & m + lRows + 1)
                .Value = "Total": .Font.Bold = True
                .Offset(, 1).Formula = "=SUM(R[-1]C:R[-" & lRows & "]C)"
                .Offset(, 3).Formula = "=SUM(R[-1]C:R[-" & lRows & "]C)"
                .Resize(1, 4).Interior.Color = vbYellow
            End With
        Next r
        With sh.Cells
            .FormatConditions.Delete: .ReadingOrder = xlRTL
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .RowHeight = 23
            .Columns(9).ColumnWidth = 10
            .Columns(11).ColumnWidth = 14
            .Font.Size = 14: .Font.Name = "Arial"
        End With
        Application.CutCopyMode = False
        On Error Resume Next
            sh.Range("I" & m & ":I" & m + lRows + 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        On Error GoTo 0
        sh.Range("A1").CurrentRegion.Borders.Value = 1
    Application.ScreenUpdating = True
    MsgBox "Done", 64
End Sub

 

[عبدالله صباح]

تسلم

جزيت خير

ممكن اضافة الى كلمة (مجموع) رقم الصفحة لتصبح (مجموع1) (مجموع2) مجموع3) وهكذا

كما بين ذلك بالملف المرفق

 

جمع كل 20 صف.xlsm

[lionheart]

So simple. Do it yourself

 Create a variable and name it for example counter

Then inside the loop and before the line that populates the value "Total" increase the variable by one like that

counter = counter + 1

And finally put the ampersand symbol after the word "Total" and the variable name which is counter. That's all

تم تعديل نوفمبر 27, 2021 بواسطه lionheart