FWIW:
Sub rizmoninzz()
Dim i As Long
Dim rcell As Range
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
For i = Range("D" & Rows.count).End(3).Row To 3 Step -1
If Range("D" & i) <> Range("D" & i + 1) Then
Rows(i + 1).Insert
End If
Next i
For Each numrange In Columns("L").SpecialCells(xlConstants, xlNumbers).Areas
SUMADDR = numrange.address(False, False)
Range(SUMADDR).Copy
Sheets("Weekday").Range("F" & Rows.count).End(3)(2).PasteSpecial Transpose:=True
C = numrange.count
Next numrange
NoData:
For Each rcell In Range("D3:D" & Range("D" & Rows.count).End(3).Row)
If Not IsNumeric(rcell.offset(-1)) Or rcell.offset(-1) = "" Then
rcell.offset(, -3).Copy Sheets("Weekday").Range("B" & Rows.count).End(3)(2)
End If
If rcell.offset(1).Value = "" Then
rcell.offset(, -3).Copy Sheets("Weekday").Range("C" & Rows.count).End(3)(2)
End If
Next rcell
With Sheets("Weekday")
For i = 3 To .Range("B" & Rows.count).End(3).Row
With .Range("E" & i)
.Formula = "=SUM(F" & i & ":L" & i & ")"
.Value = .Value
End With
Next i
End With
Sheets("Sales").Range("A2:A" & Range("A" & Rows.count).End(3).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
Bookmarks