This will do the copying over to the Formatted sheet while adding in the blank row. If I knew where and what formulas you are wanting, I could add them into the code as well.
Sub abc()
Const shMainData As String = "Sheet1"
Const shFormatted As String = "Formatted"
Const cNumOfTotalColumns As Long = 22
Dim rng As Range
Dim ptr As Long
Dim iMaxRows As Long
With Worksheets(shMainData)
Set rng = .Range("a2", .Cells(Rows.Count, "a").End(xlUp))
End With
Application.ScreenUpdating = False
With Worksheets(shFormatted)
ptr = 7 ' Starting row for data on Format sheeet
iMaxRows = .Cells(1, "f").Value
For i = 1 To rng.Rows.Count Step iMaxRows
' Copy the range over keepig format from sheet1. Little slower to process.
rng(i, 1).Resize(iMaxRows, cNumOfTotalColumns).Copy .Cells(ptr, "F")
' Below is faster but loose cell formatting for text columns.
'.Cells(ptr, "F").Resize(iMaxRows, cNumOfTotalColumns).Value = rng(i, 1).Resize(iMaxRows, cNumOfTotalColumns).Value
' Could add formula here. This will put a formula into cell. Change "R" for your neeeds
.Cells(ptr, "R").Offset(iMaxRows) = "=Subtotal(9, " & .Cells(ptr, "R").Resize(iMaxRows).Address & ")"
' This will just calculate the value and add value to cell. Change "T" for your neeeds
.Cells(ptr, "T").Offset(iMaxRows) = WorksheetFunction.Subtotal(9, .Cells(ptr, "T").Resize(iMaxRows))
ptr = ptr + iMaxRows + 1
Next
End With
Application.ScreenUpdating = True
End Sub
LinkBack URL
About LinkBacks
Register To Reply
.
Bookmarks