Sub Copier()

I finally finished my latest Excel macro. (my second one ever).
It’s awesome.
It copies each sheet of my workbook onto a new sheet, converts it into values and format, shifts it to a new workbook and deletes the temp copy. One cycle for each sheet. Automated. Awesome. Took me long enough though.

Hey visual basic looks easier than I thought. Haha.

Also learnt that when you password protect an excel file, it cannot be size-reduced by zipping. Dang.

Option Explicit
Sub Copier()

Dim ws As Worksheet
Dim wsNew As Worksheet
Dim NewName As String
Dim wsOriginalName As String

'On Error GoTo Errorcatch

If MsgBox("1. Copy to new sheet. 2. Change to values. 3. Move to new workbook" & vbCr & _
"New sheets will be pasted as values, named ranges removed" _
, vbYesNo, "NewCopy") = vbNo Then Exit Sub

' Input box to name new file
NewName = InputBox("Please Specify the month name of your new workbook", "New Copy")

With Application
.ScreenUpdating = False
.DisplayAlerts = False

'iterate through all worksheets
For Each ws In ThisWorkbook.Worksheets

'ignore hidden worksheets
If ws.Visible = xlSheetVisible Then

'copy sheet within original workbook
wsOriginalName = ws.Name
ws.Copy After:=Sheets("FAQ")

'switch to copied sheet
Set wsNew = ActiveSheet

'convert to values and format
With wsNew.UsedRange
.PasteSpecial xlPasteValuesAndNumberFormats
.PasteSpecial xlPasteFormats
.Cells(1, 1).Select
End With

'save into new workbook
ActiveWorkbook.SaveAs ThisWorkbook.Path & "" & "MIS-FY2013-" & NewName & "-" & wsOriginalName

'MsgBox ("going to try to delete: " & wsNew.Name)
'delete copied sheet

End If
Next ws

End With

End Sub
Sub Copier()

Leave a Reply

Your email address will not be published. Required fields are marked *