Snasui Excel Forum

Code: Select all

Sub InsertRow()
    Dim r As Range, rAll As Range
    Dim i As Long
    Dim lng As Long
    Application.ScreenUpdating = False
    
    With Sheets("Sheet1")
    Set rAll = .Range("C8", .Range("C" & Rows.Count).End(xlUp))
        For Each r In rAll
            If r <> r.Offset(1, 0) Then
                r.Offset(1, 22) = True
                lng = lng + 1
            End If
        Next r
        For i = 1 To lng
            Set r = .Range("Y1").End(xlDown)
            r.Resize(2, 1).EntireRow.Insert Shift:=xlShiftDown
            r.Offset(-2, -22) = "รวม"
            r.Offset(-2, -20).Formula = "=sum(" & r.Offset(-3, -20).Address & " : " & _
                IIf(r.Offset(-4, -20) = "", r.Offset(-3, -20).Address, r.Offset(-3, -20).End(xlUp).Address) & " ) "
            r.Offset(-2, -20).Formula = Application.ConvertFormula(Formula:=r.Offset(-2, -20).Formula, _
                FromReferenceStyle:=xlA1, ToReferenceStyle:=xlA1, ToAbsolute:=xlRelative)
            r.Offset(-2, -20).Resize(1, 19).FillRight
            r = ""
        Next i
        .Range("A8", .Range("W" & Rows.Count).End(xlUp).Offset(0, 1)) _
            .Borders.LineStyle = xlContinuous
    End With
    Application.ScreenUpdating = True
End Sub