Search code examples
vbaexcelmatchworksheet-function

VBA Excel Copy and Insert Varying Number of Rows with Values and Formatting

I am attempting to write a macro that would work for various worksheets. These are updated on a monthly basis. In these worksheets we have between 30 and 100 rows at the top of the sheet with formulas regarding the current month. Below we have all of the previous months numbers but without formulas.

Each month we copy the top set of rows and insert them as values w/ same formatting below the rows with formulas so that we may start the month again, but have a record of last months numbers.

In summary, I need all of the columns, and (X number of rows) copied and inserted starting in row (X+1) as only the values and formatting. Also row (X+1) is not the end of the sheet.

I have some start on the code below, but the first column does contain blank values. 

    Sub MonthlyReset()

    Dim TotalImpacts As Worksheet
    Dim LastImpacts As Range
    Dim Counter As String


   Set TotalImpacts = Worksheets("Total Impacts")

Counter = Application.WorksheetFunction.Match("STOP", ThisWorkbook.Sheets(TotalImpacts).Column(1), 0)

LastImpacts = ThisWorkbook.Sheets(TotalImpacts).Rows("1:" & Counter)
Rows(Counter).Resize(Counter).Insert

'Copying Impacts
ThisWorkbook.Sheets(TotalImpacts).LastImpacts.Copy
'Paste Values then Formatting
ThisWorkbook.Sheets(TotalImpacts).Range("A" & Counter + 1).PasteSpecial Paste:=xlPasteValues
ThisWorkbook.Sheets(TotalImpacts).Range("A" & Counter + 1).PasteSpecial Paste:=xlPasteFormats
'Clear Clipboard
Application.CutCopyMode = False


End Sub
Solution

  • This isn't the most efficient way, but inserting entire rows can be a pain in excel, interestingly enough. But trying to be true to your original ideas, this should work.

    Sub MonthlyReset()

Dim TotalImpacts As Worksheet
Dim LastImpacts As Range
Dim Counter As String


'Set the worksheet we are working with
Set TotalImpacts = Worksheets("Total Impacts")

'Find the row that STOP is on
Counter = Application.WorksheetFunction.Match("STOP", TotalImpacts.Columns(1), 0)

'Set the range for the data we want to copy
Set LastImpacts = TotalImpacts.Rows("1:" & Counter)

'Copy and insert
LastImpacts.Copy
LastImpacts.Offset(Counter).Insert shift:=xlShiftDown

'Paste Values then Formatting
TotalImpacts.Range("A" & Counter + 1).PasteSpecial Paste:=xlPasteValues
TotalImpacts.Range("A" & Counter + 1).PasteSpecial Paste:=xlPasteFormats

'Clear Clipboard
Application.CutCopyMode = False


End Sub

    In the end, the range is pasted twice, the first time with the formulas to be able to insert the correct amount of rows. The second time is to paste values and then formulas alone, as you had done in your original code.