Worksheet
These macro codes will
help you to control and manage worksheets in an easy way and save your a lot of
time.
Hide all but the Active Worksheet
Now, let's say if you want to hide all the worksheets in your
workbook other than the active worksheet. This macro code will do this for you.
Sub HideWorksheet()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> ThisWorkbook.ActiveSheet.Name Then
ws.Visible = xlSheetHidden
End If
Next ws
End Sub
Unhide all Hidden Worksheets
And, if you want to un-hide all the worksheets which you have
hide with previous code, here is the code for that.
Sub UnhideAllWorksheet()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Visible = xlSheetVisible
Next ws
End Sub
Delete all but the Active Worksheet
If you want to delete all the worksheets other than the active
sheet, this macro is useful for you. When you run this macro it will
compare the name of the active worksheet with other worksheets and then delete
them.
Sub DeleteWorksheets()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.name <> ThisWorkbook.ActiveSheet.name Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next ws
End Sub
Protect all Worksheets Instantly
If you want to protect your all worksheets in one go here is a
code for you. When you run this macro, you will get an input box to enter
a password. Once you enter your password, click OK. And, make sure to take care
about CAPS.
Sub ProtectAllWorskeets()
Dim ws As Worksheet
Dim ps As String
ps = InputBox("Enter a Password.", vbOKCancel)
For Each ws In ActiveWorkbook.Worksheets
ws.Protect Password:=ps
Next ws
End Sub
Resize All Charts in a Worksheet
Make all chart same in size. This macro code will help you to
make all the charts of the same size. You can change the height and width of
charts by changing it in macro code.
Sub Resize_Charts()
Dim i As Integer
For i = 1 To ActiveSheet.ChartObjects.Count
With ActiveSheet.ChartObjects(i)
.Width = 300
.Height = 200
End With
Next i
End Sub
Insert Multiple Worksheets
You can use this code if you want to add multiple worksheets in
your workbook in a single shot. When you run this macro code you will get an
input box to enter the total number of sheets you want to enter.
Sub InsertMultipleSheets()
Dim i As Integer
i = InputBox("Enter number of sheets to insert.",
"Enter Multiple Sheets")
Sheets.Add After:=ActiveSheet, Count:=i
End Sub
Protect Worksheet
If you want to protect your worksheet you can use this macro
code. All you have to do just mention your password in the code.
Sub ProtectWS()
ActiveSheet.Protect "mypassword", True, True
End Sub
Unprotect Worksheet
If you want to unprotect your worksheet you can use this macro
code. All you have to do just mention your password which you have used while
protecting your worksheet.
Sub UnprotectWS()
ActiveSheet.Unprotect "mypassword"
End Sub
Sort Worksheets
This code will help you to sort worksheets in your workbook
according to their name.
Sub SortWorksheets()
Dim i As Integer
Dim j As Integer
Dim iAnswer As VbMsgBoxResult
iAnswer = MsgBox("Sort Sheets in Ascending Order?"
& Chr(10) _
& "Clicking No will sort in Descending Order", _
vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort
Worksheets")
For i = 1 To Sheets.Count
For j = 1 To Sheets.Count - 1
If iAnswer = vbYes Then
If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then
Sheets(j).Move After:=Sheets(j + 1)
End If
ElseIf iAnswer = vbNo Then
If UCase$(Sheets(j).Name) < UCase$(Sheets(j + 1).Name) Then
Sheets(j).Move After:=Sheets(j + 1)
End If
End If
Next j
Next i
End Sub
Delete all but the Active Worksheet
If you want to delete all the worksheets other than the active
sheet, this macro is useful for you. When you run this macro it will
compare the name of the active worksheet with other worksheets and then delete
them.
Sub DeleteWorksheets()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.name <> ThisWorkbook.ActiveSheet.name Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next ws
End Sub
No comments:
Post a Comment