I want to ask about rename the excel sheet, i want to rename the sheet with new name : older name + _v1.
So if my current sheet name is test, then I want the new name test_v1.
I only know the standard vba for rename excel sheet which is renaming excel sheet by the sheet content.
Sub Test()
Dim WS As Worksheet
For Each WS In Sheets
WS.Name = WS.Range("A5")
Next WS
End Sub
The "no frills" options are as follows:
ActiveSheet.Name = "New Name"
and
Sheets("Sheet2").Name = "New Name"
You can also check out recording macros and seeing what code it gives you, it's a great way to start learning some of the more vanilla functions.
This should do it:
WS.Name = WS.Name & "_v1"
Suggest you add handling to test if any of the sheets to be renamed already exist:
Sub Test()
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim strErr As String
On Error Resume Next
For Each ws In ActiveWorkbook.Sheets
Set ws1 = Sheets(ws.Name & "_v1")
If ws1 Is Nothing Then
ws.Name = ws.Name & "_v1"
Else
strErr = strErr & ws.Name & "_v1" & vbNewLine
End If
Set ws1 = Nothing
Next
On Error GoTo 0
If Len(strErr) > 0 Then MsgBox strErr, vbOKOnly, "these sheets already existed"
End Sub
Related
I would like to rename sheets based on the same cell within each sheet. When i run the macro rather than having the cell predefined I would like to use an input box to define what cell the sheets are to be named after. This is what I have so far- currently it works for only cell C8.
Sub RenameSheet()
Dim ws As Worksheet
For Each ws In Worksheets
On Error Resume Next
If Len(ws.Range("C8")) > 0 Then
ws.Name = ws.Range("C8").Value
End If
On Error GoTo 0
If ws.Name <> ws.Range("C8").Value Then
MsgBox ws.Name & " Was Not renamed, the suggested name was invalid"
End If
Next
End Sub
I think this code would help but I cannot get it to run
Set CellID = Application.InputBox("Cell reference to label sheets", Type:=8)
Anyone have help on this?
I suggest the following changes.
Also it would be a good idea to activate the current sheet so the user always automatically selects a cell on the correct sheet.
Option Explicit
Public Sub RenameSheet()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Activate 'so we automatically are on the correct sheet to select a range
Dim CellID As Range
Set CellID = Application.InputBox("Cell reference to label sheets", Type:=8)
If CellID.Count > 1 Then 'check how many cells were selected
MsgBox "Please select only one cell!", vbExclamation
Exit Sub
End If
If Len(CellID.Value) > 0 Then
On Error Resume Next
ws.Name = CellID.Value
'catch the error
If Err.Number <> 0 Then MsgBox ws.Name & " Was Not renamed, the suggested name was invalid"
On Error GoTo 0
Else
MsgBox ws.Name & " Was Not renamed, the suggested name was empty"
End If
Next ws
End Sub
Alternative to select the address once and use the same address on every worksheet.
Option Explicit
Public Sub RenameSheet()
Dim CellID As Range
Set CellID = Application.InputBox("Cell reference to label sheets", Type:=8)
If CellID.Count > 1 Then 'check how many cells were selected
MsgBox "Please select only one cell!", vbExclamation
Exit Sub
End If
Dim NameAddress As String
NameAddress = CellID.Address(External:=False)
Dim ws As Worksheet
For Each ws In Worksheets
If Len(ws.Range(NameAddress).Value) > 0 Then
On Error Resume Next
ws.Name = ws.Range(NameAddress).Value
If Err.Number <> 0 Then MsgBox ws.Name & " Was Not renamed, the suggested name was invalid"
On Error GoTo 0
Else
MsgBox ws.Name & " Was Not renamed, the suggested name was empty"
End If
Next ws
End Sub
This should work for you:
Sub RenameSheet()
Dim ws As Worksheet, CellID As Range
For Each ws In ThisWorkbook.Worksheets
Set CellID = Application.InputBox("Cell reference to label sheets", Type:=8)
Set CellID = ws.Cells(CellID.Row, CellID.Column)
On Error Resume Next
ws.Name = CellID
On Error GoTo 0
If ws.Name <> CellID.Value Then
MsgBox ws.Name & " Was Not renamed, the suggested name was invalid"
End If
Next
End Sub
This code will set your range twice, because the inputbox assumes ActiveSheet, as there's no way to assign the worksheet name to your input range without typing it out.
Therefore, once you type in the cell address, it will utilize the .Row and .Column properties of the inputrange of the activesheet, while assigning them to the correct worksheet since we didn't qualify the worksheet in CellID.Row and CellID.Column.
I have a worksheet named "Book 1". I have no problem copy to after that worksheet. My issue is the next copy, I will already have "Book 1" then "Book 1 (2)" I need to copy the "Book 1" but place it after "Book 1(2)" and so forth with the next copy. How can I keep track or know where to place the next copy? I Don't want to put it at the end either because there are other tabs at the end that needs to be there.
Sub CopySheet()
Dim ws As Worksheet
For Each ws In Worksheets
If Left(ws.Name, 4) = "Book" Then
Sheets("Book 1").Copy After:=Sheets(ws.Name)
End If
Next ws
End Sub
Try this tested code. Worked for me:
Option Explicit
Sub CopySheet()
'copy Book 1 sheet
ThisWorkbook.Worksheets("Book 1").Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
'assign to variable to move later
Dim wsPlacement As Worksheet
Set wsPlacement = ActiveSheet
'load all "Book 1" sheets
Dim ws As Worksheet
For Each ws In Worksheets
If Left(ws.Name, 6) = "Book 1" And ws.Name <> wsPlacement.Name Then
Dim sSheets As String
sSheets = sSheets & "," & ws.Name
End If
Next ws
'find last one (by index) and move copy after that one
'this works so long as sheets stay in numerical order of copy
'if not it will put sheet at last position (by index) of Book 1 sheets
sSheets = Mid(sSheets, 2) 'remove leading comma
Dim arrSheets() As String
arrSheets = Split(sSheets, ",")
wsPlacement.Move After:=ThisWorkbook.Worksheets(arrSheets(UBound(arrSheets)))
End Sub
Loop backwards thru all sheets and copy it after the last where the name matches.
Sub copyMe(ws As Worksheet)
Dim wb As Workbook
Dim i As Long
Set wb = ws.Parent
For i = wb.Sheets.Count To 1 Step -1
If ws.Name = Left(wb.Sheets(i).Name, Len(ws.Name)) Then
ws.Copy After:=wb.Sheets(i)
Exit For
End If
Next i
End Sub
I have searched everywhere for an answer to this, but I can't find one. how do I check if there is more than 1 worksheet in Workbook.
To get the number of worksheets within an open workbook, something like:
Sub qwerty()
MsgBox "the number of worksheets in this workbook is: " & ThisWorkbook.Worksheets.Count
End Sub
This will exclude Charts, etc.If you have multiple workbooks open, then something like:
MsgBox "the number of worksheets in this workbook is: " & wb.Worksheets.Count
Where you would Set wb in a prior statement.
To run it from Personal.xlsb then Try this
Public Sub Count_Sheets()
Debug.Print "You Have " & Application.Sheets.count & " Sheets " ' Immediate Window
MsgBox "You Have " & Application.Sheets.count & " Sheets "
End Sub
Or use ActiveWorkbook.Sheets.count
This is what ended up working best for me. It incorporates multiple answers in here to do what it does.
Sub CountSheets()
Dim mainWB As Workbook
Dim mainWS As Worksheet
Set mainWB = ActiveWorkbook
Set mainWS = mainWB.Sheets(1)
If mainWB.Sheets.Count > 1 Then MsgBox "There is more than one worksheet in this Excel file."
End Sub
I need to cycle through sheets of index 3 tip last sheet and run a code. I tried something like this but its doesn't work.
If (ws.sheetIndex > 2) Then
With ws
'code goes here
End With
End If
I did a search but don't find a solution to this problem. Help would be much appreciated.
I also tried:
Dim i As Long, lr As Long
Dim ws As Worksheet
Windows("Book1").Activate
With ActiveWorkbook
Set ws = .Worksheets("index")
For i = 3 To 10
'code goes here
Next i
End With
You can try the following, which iterates over all worksheets in your workbook and only "acts" for worksheets with index 3 or above.
Dim sheet As Worksheet
For Each sheet In ActiveWorkbook.Worksheets
If sheet.Index > 2 Then
' Do your thing with each "sheet" object, e.g.:
sheet.Cells(1, 1).Value = "hi"
End If
Next
Note that this doesn't put a hard limit on the number of sheets you have (10 or whatever), as it will work with any number of worksheets in your active workbook.
EDIT
If you want the code to run on worksheets with names "Sheet" + i (where i is an index number from 3 onwards), then the following should help:
Dim sheet As Worksheet
Dim i As Long
For i = 3 To ActiveWorkbook.Worksheets.Count
Set sheet = ActiveWorkbook.Worksheets(i)
If sheet.Name = "Sheet" & i Then
' Do your thing with each "sheet" object, e.g.:
sheet.Cells(2, 2).Value = "hi"
End If
Next i
Of course, this means that the names of your worksheets need to always follow this pattern, so it's not best practice. However, if you're sure the names are going to stay like this, then it should work well for you.
Try excluding first and second sheet using name:
Public Sub Sheets3andUp()
Dim ws As Worksheet
Dim nameOfSheet1 As String
Dim nameOfSheet2 As String
nameOfSheet1 = "Sheet1"
nameOfSheet2 = "Sheet2"
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> nameOfSheet1 And ws.Name <> nameOfSheet2 Then
'Code goes here
Debug.Print ws.Name
End If
Next ws
End Sub
Note that the user can reorder the sheets in the Worksheets Collection, so it is better to refer to the sheets by CodeName (which the user cannot change), and exclude by CodeName the sheets to be skipped, as here:
Public Sub TestLoop()
On Error GoTo ErrHandler
Dim ws As Worksheet, s As String
For Each ws In Worksheets
If ws.CodeName <> "Sheet2" Then
s = s & vbNewLine & ws.CodeName
End If
Next ws
s = "WorksheetList (except Sheet2:" & vbNewLine & vbNewLine & s
MsgBox s, vbOKOnly, "Test"
EndSUb:
Exit Sub
ErrHandler:
Resume EndSUb
End Sub
If I drag Sheet 3 to precede Sheet1, the MsgBox outputs:
WorksheetList (except Sheet2:
Sheet3
Sheet1
I am trying to create a macro that will copy actual sheet and name it with next letter of the alphabet. First sheet "A" always exists in the workbook, other sheets (B, C, D, etc.) will be added as necessary. I managed to put together the following piece of code that can create sheet "B". Issue is that when copying sheet "B", I get Run-time error '1004' indicating error on the last line of code.
Sub newList()
' New_List Macro
Dim PrevLetter As String
PrevLetter = "ActiveSheet.Name"
ActiveSheet.Copy after:=ActiveSheet
ActiveSheet.Name = Chr(Asc(PrevLetter) + 1)
End Sub
Can anyone of you help?
Your code is giving an error as Soren mentioned.
However your code will give an error if sheet "A" is active after creation of "B" as sheet "B" already exists.
You might want to try this? for this, it's not important which sheet is active. Also this code will let you create sheets beyond Z. So sheets after Z will be named as AA, AB etc..
Using this code, In XL2007+ you can create sheets up till XFD (more 16383 sheets)
Using this code, In XL2003 you can create sheets up till IV (more 255 sheets)
CODE:
Sub newList()
Dim PrevLetter As String
Dim ws As Worksheet, wsNew As Worksheet
Dim wsname As String
Set ws = ThisWorkbook.Sheets("A")
ws.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Set wsNew = ActiveSheet
wsname = GetNewName
wsNew.Name = wsname
End Sub
Function GetNewName() As String
Dim NewWs As Worksheet
For i = 2 To ThisWorkbook.Sheets(1).Columns.Count
ColName = Split(ThisWorkbook.Sheets(1).Cells(, i).Address, "$")(1)
On Error Resume Next
Set NewWs = ThisWorkbook.Sheets(ColName)
If Err.Number <> 0 Then
GetNewName = ColName
Exit For
End If
Next i
End Function
You should simply write your code like this instead:
Sub newList()
' New_List Macro
Dim PrevLetter As String
PrevLetter = ActiveSheet.Name '<--- Change made to this line
ActiveSheet.Copy after:=ActiveSheet
ActiveSheet.Name = Chr(Asc(PrevLetter) + 1)
End Sub
EDIT: This is not a "best practice code" answer. This just points out what in your own code were returning the error. The other answers to this question (so far) are indeed much more sophisticated and correct ways of solving this problem.
Here is another way you could do this:
Sub newList()
' New_List Macro
Dim PrevLetter As String
Dim wb As Workbook
Dim ws1 As Worksheet
Set wb = ActiveWorkbook
Set ws1 = wb.ActiveSheet
PrevLetter = ws1.Name
ws1.Copy After:=ws1
Sheets(Sheets.Count).Name = Chr(Asc(PrevLetter) + 1)
Set wb = Nothing
Set ws1 = Nothing
End Sub