Automatic Cut/Paste to new sheet at every month end

[Richard649]

Hello everyone,

I've been trying to create a macro to cut/paste data from sheet1 to sheet2 automatically at the last date of every month. Request you to help me how to get the month end code through vba. Sample file attached for your reference.

Any help would be greatly appreciated. Thanks!:help

[GTO]

Hi Richard,

Maybe just me, but what is the overall goal? If we just cut and paste, then we simply moved the data to another sheet. Could you describe what would happen in months two, three and so on? In other words, are we just needing a 'fresh' sheet1, and the old data gets appended to any pre-existing on the other sheet?

Mark

[Richard649]

Hi Mark,

Thanks for the reply. You got the point; we just need a fresh 'Sheet1' and old data gets appended to any pre-existing on 'Sheet2' automatically every month end.

Any help would be greatly appreciated. Thanks!

[GTO]

Hi Richard,

Please note that I used the source and destination sheets' codenames. As it appears that you are not deleting the sheets, this seems more assured to me (and easier), as a user renaming a tab doesn't throw the code into a tailspin.

Option Explicit

Sub exa()
Dim _
rngSource As Range, _
rngDestFirstCell As Range

'// Note: rename the sheets' codenames//
With shtSheet1
Set rngSource = RangeFound(Range(.Range("A2"), .Cells(.Rows.Count, "O")))

If rngSource Is Nothing Then
MsgBox "No source records...", vbInformation, vbNullString
Exit Sub
End If

Set rngSource = Range(.Range("A2"), .Cells(rngSource.Row, "O"))

End With

With shtSheet2
Set rngDestFirstCell = RangeFound(Range(.Range("A2"), .Cells(.Rows.Count, "O")))

If rngDestFirstCell Is Nothing Then
Set rngDestFirstCell = .Range("A2")
Else
Set rngDestFirstCell = .Range("A" & rngDestFirstCell.Row + 1)
End If

rngDestFirstCell.Resize(rngSource.Rows.Count, 15).Value = rngSource.Value
rngSource.ClearContents
End With

End Sub

Function RangeFound(SearchRange As Range, _
Optional FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function
Hope that helps,

Mark