Copy active worksheets

[ja-finn]

Hi

I have a workbook that I use for inventory tracking. I make a copy of the last worksheet almost every day and name it todays date. After some time the workbook becomes very large and slow to work with. I am therefore trying to create a macro that will move all previous months sheets to a new workbook.

This is the code I have come up with so far:

Sub autoarchive()

Dim wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
If UCase(wks.Range("E1").Value) = UCase("FALSE") Then
wks.Select False

End If
Next wks

'Move selected worksheets to new workbook
If ThisWorkbook.Sheets.Count < 2 Then
Exit Sub
Else
ActiveWindow.SelectedSheets.Copy

End If

End Sub

I have created a formula in E1 that extracts the sheet name and checks wether the month is the same as the current month. This way it will only archive the old sheets.

The part I can't understand is that if I replace "ActiveWindow.SelectedSheets.Copy" with "ActiveWindow.SelectedSheets.Visible = xlSheetHidden" it works as I want it to and hides the old sheets but when I try to copy them it copies all the worksheets in the workbook and not just the old ones.

Any suggestions?

 

[Norie]

Why not instead of creating a copy of the worksheet in the current workbook created it in a new workbook?

Then archive the current one and make the new one the current one.

Or is this a one off thing that you need to do now for the current workbook?

 

[ja-finn]

Why not instead of creating a copy of the worksheet in the current workbook created it in a new workbook?

Then archive the current one and make the new one the current one.

Or is this a one off thing that you need to do now for the current workbook?

This is excactly what I am trying to accomplish

To my knowledge "ActiveWindow.SelectedSheets.Copy" should copy the selected sheets to a new workbook. When I get the macro working properly I will change it to "ActiveWindow.SelectedSheets.Move". I just used copy for now since I can't use the undo function when running a macro.

I will run the macro around the end of every month or so.

 

[Norie]

I don't think you quite understand what I mean - I was suggesting a slightly different approach.

If want to stick with your original idea this might be a better idea, which doesn't involve selecting.

Option Explicit
 
Sub CopyWorksheets()
Dim ws As Worksheet
Dim arrShts()
Dim I As Long
 
     For Each ws In ThisWorkbook.Worksheets
             If UCase(ws.Range("E1").Value) = "FALSE" Then
                ReDim Preserve arrShts(I)
                arrShts(I) = ws.Name
                I = I + 1
             End If
     Next ws
 
     ThisWorkbook.Worksheets(arrShts).Copy
 
End Sub

 

[ja-finn]

Thank you very much This works almost perfect. The only thing is that it also copies the first worksheet. Any suggestions on how to solve this?

My initial thought was to select the last worksheet prior to running the code with

Sheets(Sheets.Count).Select

but it didn't work...

 

[Norie]

The code copies all the worksheets that have FALSE in cell E1, regardless of anything else.

Isn't that what you wanted to do?

That's what the original code seemed to be, did I get that wrong?

PS Whatever you do, don't use Select.

 

[ja-finn]

I'm sorry, my mistake. I found that the error was actually in the formula I made to evaluate how old the sheet was. Corrected it and now it works like a charm.

Thank you for a quick and helpful reply

 

[Norie]

No problem.

You might want to consider some other way to decide which worksheets to copy.

It should be quite easy to check the sheet name in the code, so you wouldn't need to rely on the formula.