Archive month then delete it every month.

[Aussie Grid]

Hi, I'd like some assistance to automatically archive a calendar mths worth of data via VBA. In col "A" I have the criteria and from "B" to "AE", in the case of November, the dates. I need to copy and paste "A" to "AE" into a new sheet and then come back and delete the months data, ie "B" to "AE". Obviously the "AE" column varies depending on the month, and next Feb is 29 days so that's a further consideration. I'd like it to be automatic when the sheet is activated in the next month so as to avoid input mistakes in the case of an input box, or just plain selection mistakes in the case of manual selection. It's a continuous sheet that contains dates out to "IS" and a macro adds a new month on the end after the previous month is deleted.

Any and all help appreciated.
Aussie Grid

 

[b.downey]

Could you provide an example of the data?

 

[Aussie Grid]

"A" "B" "C" etc etc etc out to "IS"
Staff 1/11/11 1/11/11
Bill X
Bob X
Jen X
etc etc etc

I need to archive each month to a new sheet and then delete the copied data from original sheet. Not forgeting that there are 29 dys next Feb

Aussie Grid

 

[b.downey]

The attached code extracts the First day of the months from cell B1.

It then will calculate the "last day" of the current month.
A new worrksheet will be create and be name using the Last day.

Columns A thru the last day of the current month will be copyed over to the new spreasheet

Columns B thru the las day of the current month will be delete from the original spreadsheet

Cell "B1" on the original spreadseet will be advanced 1 month

Option Explicit
Sub MonthEndBackUp()
    Dim Wb As Workbook
    Dim Ws As Worksheet
    Dim DstWs As Worksheet
    Dim LastDate As Date
    Dim LastCol As Long
    
    Set Wb = ThisWorkbook
    Set Ws = Wb.Worksheets(1)
    
    'B1 should be the first day of the current month
    If Not IsDate(CDate(Ws.Range("B1"))) Then
        MsgBox "Cell: B1 is not a date!", vbCritical
        Exit Sub
    End If
    
    'Determine the Last day of the current month
    LastDate = DateAdd("M", 1, Ws.Range("B1")) - 1
    LastCol = Day(LastDate) + 1
    
    'Add New WS for the data
    Wb.Sheets.Add After:=Sheets(Sheets.Count)
    Set DstWs = Wb.ActiveSheet
    DstWs.Name = "BU-" & Replace(CStr(LastDate), "/", "-")
    
    Ws.Select
    Ws.Range(Columns(1), Columns(LastCol)).Copy Destination:=DstWs.Range("A1")
    Ws.Range(Columns(2), Columns(LastCol)).ClearContents
    
    Ws.Range("B1") = LastDate + 1
End Sub

 

[Aussie Grid]

Thank you very much for your help it is greatly appreciated.

Aussie Grid

 

[Aussie Grid]

I get the 2 errors below in my workbook but the code is perfect in a new workbook so will figure it out.
Runtime error 104 - Application defined or object defined error from both lines:
DstWs.Name = "BU-" & Replace(CStr(LastDate), "/", "-")
Ws.Range(Columns(1), Columns(LastCol)).Copy Destination:=DstWs.Range("A1")
Again thank you very much
Aussie Grid

 

[b.downey]

Glad I could help. Thanks for the feed back..