Archive old weeks in Schedule file

[Revoo]

Hello!

Me and my colleagues uses an excel file to show our work schedule week by week. However as the weeks go by its more and more annoying having to scroll further and further to the right to see how your current schedule is.

My question is: Is it possible to cut out all the old weeks automaticaly and paste it in another sheet as an "archive"?. Make it automatic so when you open the file on monday for example the previous week will already be moved by itself.

Thanks for reading and hope I can get some help with this!

 

[Revoo]

Well.. This gives me some direction to look at. How should I differentiate the current week, previous week and future weeks?? do you have any column names with dates?

somehow the pictures not getting loaded in my computer. the reason why I am asking more details from you.

Check this link, hope it helps! Imgur: The most awesome images on the Internet

Each column is one day, then the week number stretches over 7 days in the row above.

Teach name to the left has a few rows for status and work schedule.

 

[bhos123]

I am not able to open this due to network restrictions at office. I will send you the replay same time tomorrow.

 

[Revoo]

I am not able to open this due to network restrictions at office. I will send you the replay same time tomorrow.

Okay! That sucks, hate restrictions! Poke me when you need anything I will be waiting. Thanks for the help!

 

[bhos123]

The restrictions are kept for our network safety concerns only. Hope someone else picks this up. I will try with someone else as it is very urgent for you.

 

[AkaTrouble]

this is a test to see if image is displayed to get round network restrictions

 

[bhos123]

Sub latest()
Dim LastCol As Integer
Dim Lastcol1 As Integer
Sheets("Sheet1").Select
With ActiveSheet
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With


If Sheets(1).Name = "Sheet1" Then
Sheets("Sheet1").Select
Sheets("Sheet1").Copy Before:=Sheets(1)
Sheets("Sheet1 (2)").Select
Sheets("Sheet1 (2)").Name = "Archive"
Range(Cells(, LastCol - 6), Cells(, LastCol)).Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Sheets("Sheet1").Select
Range(Cells(, 1), Cells(, LastCol - 7)).Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Else
Sheets("Sheet1").Select
With ActiveSheet
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
If LastCol > 7 Then
Range(Cells(, 1), Cells(, LastCol - 7)).Select
Selection.Cut
Sheets("Archive").Select
With ActiveSheet
Lastcol1 = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
End With
Range(Cells(, Lastcol1), Cells(, Lastcol1)).Select
Selection.Insert Shift:=xlToRight
Range("A1").Select
Sheets("Sheet1").Select
Range(Cells(, 1), Cells(, 7)).Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select

End If
End If

End Sub

 

[Revoo]

Sub latest()
Dim LastCol As Integer
Dim Lastcol1 As Integer
Sheets("Sheet1").Select
With ActiveSheet
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With


If Sheets(1).Name = "Sheet1" Then
Sheets("Sheet1").Select
Sheets("Sheet1").Copy Before:=Sheets(1)
Sheets("Sheet1 (2)").Select
Sheets("Sheet1 (2)").Name = "Archive"
Range(Cells(, LastCol - 6), Cells(, LastCol)).Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Sheets("Sheet1").Select
Range(Cells(, 1), Cells(, LastCol - 7)).Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Else
Sheets("Sheet1").Select
With ActiveSheet
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
If LastCol > 7 Then
Range(Cells(, 1), Cells(, LastCol - 7)).Select
Selection.Cut
Sheets("Archive").Select
With ActiveSheet
Lastcol1 = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
End With
Range(Cells(, Lastcol1), Cells(, Lastcol1)).Select
Selection.Insert Shift:=xlToRight
Range("A1").Select
Sheets("Sheet1").Select
Range(Cells(, 1), Cells(, 7)).Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select

End If
End If

End Sub

Code only seem to copy once then no more again. Am I supposed to make a macro out of this and assign a button to it or should I use it in another way?

 

[bhos123]

you need to run this code. each time when you open or update the file.