Active sheet name change in sequence - excel

I've got a workbook with two spreadsheets named "WT-1" and "CL-1" (it could be more of them with diff. names).
When i.e. "WT-1" is active, I would like to be able to (by using a button with macro assigned to it) copy this current (active) spreadsheet and rename it in sequence like WT-2, WT-3, WT-4 etc .
I guess change needs to apply only to spreadsheets who's name contains "WT-" as the name change should be addressed to the new sheet only. All other existing worksheets should not be touched. here it is - Pls help :) It changes name of one new spreadsheet. If there is more than just 1 worksheet in my workbook, it doesn't work.
Sub changeWSname()
Dim ws As Worksheet
Dim shtName As Variant
Dim Rng As Range
Dim i As Long
With Sheets("wslist")
Set Rng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp).Address)
shtName = Application.Transpose(Rng)
i = LBound(shtName)
End With
For Each ws In ActiveWorkbook.Worksheets
If Left(Trim(ws.Name), 3) = "WT-" Then
ws.Name = shtName(i)
i = i + 1
End If
Next ws
End Sub
Macro is suppose just to change the name of a new and freshly copied spreadsheet. So if I copy WT-2 and create new sheet named WT-2(2) and run macro - it will work and change new sheet name to WT-1 (being first name in the range on 'wslist') . That seems to be OK. But, if I have any other spreadsheet in my workbook (except active sheet and already copied new sheet) it doesn't work and gives me an error 1004 - "Cannot rename a sheet to the same name as another sheet, a referenced object library or a workbook referenced by Visual Basic"
When I click on de-bag, this I found highlighted: ws.Name = shtName(i)

The issue is if you have the situation with following sheets
WT-1
WT-1 (2)
WT-2
Your code tries to rename WT-1 (2) into WT-2 but that already exists.
So a possibility was you would need to rename these to something else first like
WT-1
#WT-2
#WT-3
and then remove the # in another loop.
This way you prevent renaming into a name that already exists.
Option Explicit
Public Sub changeWSname()
Dim ws As Worksheet
Dim shtName As Variant
Dim Rng As Range
Dim i As Long
With Sheets("wslist")
Set Rng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp).Address)
shtName = Application.Transpose(Rng)
i = LBound(shtName)
End With
For Each ws In ActiveWorkbook.Worksheets
If Left$(Trim(ws.Name), 3) = "WT-" Then
'test if we run out of sheet names
If i > UBound(shtName) Then
MsgBox "Running out of sheet names … aborting"
Exit Sub
End If
ws.Name = "#" & shtName(i) 'add a # to all new sheet names
i = i + 1
End If
Next ws
'remove the # from the sheet nam
For Each ws In ActiveWorkbook.Worksheets
If Left$(Trim(ws.Name), 1) = "#" Then
ws.Name = Right$(ws.Name, Len(ws.Name) - 1)
End If
Next ws
End Sub
As QHarr pointed out it's probably a good idea to test if you are running out of sheet names.

Related

Rename sheet with if sheet name already exists while looping workbooks

I am running my code trying to loop through old and new formatted workbooks.
And the sheet names in my old workbooks are different from the new workbooks.
The code is set to run when the new workbook's names are found.
The old workbooks have sheets named "01", "02" and "03".
The new workbooks have sheets named "newname01", "newname02" and "03".
The code is set to run to "newname01" and "newname02".
What I need to do is if the code runs through an old workbook, change the old sheet names to the new workbook's sheet names and run the code. And when running through a new workbook, run through it without changing the sheet names.
I tried changing the old workbook's sheet names to the new ones at the beginning of the code. But when the code is running through an old workbook, its sheets don't contain the new names the code shows an error.
I tried using -
If Not______Is Nothing then.
But I couldn't figure out how that code works.
my code--->
Sub CD3()
Dim wb As Workbook
For Each wb In Application.Workbooks
If Not Application.ActiveProtectedViewWindow Is Nothing Then
Application.ActiveProtectedViewWindow.Edit
End If
Sheets("newname01").Select
Range("A8:B10").Orientation = 90
Range("C10:D10").Orientation = 90
Range("E8:F10").Orientation = 90
Range("G10:H10").Orientation = 90
Range("I8:J10").Orientation = 90
Range("K10:N10").Orientation = 90
Range("O8:Q10").Orientation = 90
Range("Q8:Q10").FormulaR1C1 = "Observation/ Proposals"
'List Sheet Adding
Sheets.Add After:=Sheets("newname02")
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "03"
'more code
ActiveWindow.Zoom = 75
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 1
Range("A11").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
Next ws
End Sub
When the code is running through an old workbook, it has sheets named "01" and "02". I need to change their name to "newname01" and "newname02" and then run the code.
this is a code I found it changed the code regardles of the name
Sub RenameSheet()
Dim Sht As Worksheet
Dim NewSht As Worksheet
Dim newShtName As String
Set NewSht = ActiveSheet
newShtName = "newname01"
For Each Sht In ThisWorkbook.Sheets
If Sht.Name = "newname02" Then
newShtName = "newname01" & "_" &
ThisWorkbook.Sheets.Count
End If
Next Sht
NewSht.Name = newShtName
End Sub
I only need to Change sheet name "01" to "newname01" and "02" to "newname02". And when it already named "newname01" run the rest of the code.
?I tride using -
If Not______Is Nothing then.
I have a feeling that you are not using proper error handling and hence that line or the one before that where you are setting the worksheet is erroring out. Try something like this (UNTESTED)
Option Explicit
Sub Sample()
Dim wbOld As Workbook
Dim wbNew As Workbook
Dim wsOld As Worksheet
Dim wsNew As Worksheet
Dim wsName As String
'~~> Change these two as applicable
Set wbOld = Workbooks("OldWorkBook")
Set wbNew = Workbooks("NewWorkBook")
'~~> Loop through the worksheets in the old workbook
For Each wsOld In wbOld.Worksheets
'~~> Create the name as per new worksheet
'newname01
wsName = "newname" & wsOld.Name
'~~> Attempt to set it. If the worksheet doesn't
'~~> exists, you will not get an error
On Error Resume Next
Set wsNew = wbNew.Sheets(wsName)
On Error GoTo 0
'~~> Check if the object is not nothing
If Not wsNew Is Nothing Then
'~~> Worksheet exists
'
'~~> Do what you want
'
'~~> This is important to prevent false positives
Set wsNew = Nothing
End If
Next wsOld
End Sub
I Wrote two Codes for the two sheet names. The run the code Below
Sub If_Run()
If Not Application.ActiveProtectedViewWindow Is Nothing Then
Application.ActiveProtectedViewWindow.Edit
End If
'Run_for_newname01() = for workbooks containing a Sheet with "newname01"
'Run_for_01() = for workbooks containing a Sheet with "01"
ws = ActiveWorkbook.Worksheets.Count
For i = 1 To ws
With ActiveWorkbook.Worksheets(i)
If .Name Like "*newname01*" Then
Run_for_newname01
ElseIf .Name Like "*01*" Then
Run_for_01
End If
End With
Next i
End Sub

Move Worksheet based off a cell value to another workbook

I'm hoping someone can help with this but I'm having the darnest time getting anything to work.
I have a rather large workbook with lots of worksheets, I have a report that runs and populates Column B with a "trigger"
Column A: is the name of all the worksheets in the workbook. Column B is the indicator that the specific worksheet needs to be moved, e.g. "Yes". I need to move the specified workbook into another workbook.
I can only find applicable examples for moving cells but it didn't work. Any help or direction will be greatly appreciated!
Dim WBK As Workbook
Dim WBK2 As Workbook
Set WBK= ThisWorkbook
Set WBK= Workbooks.Open(Filename:"ReportList.xlsx")
For i = 1 To Sheets("MoveSheet").End(xlDown).Row '(ERRORHERE)
If Sheets("MoveSheet").Range("B" & i) = "Move" Then
Sheets(Sheets("MoveSHeet").Range("A" & i)).Move After:=wkbk2.Sheets(1)
Else
End if
Next i
End Sub
Your posted code is not too far off - a few typos etc
Try this:
Sub Tester()
Dim wb As Workbook, wsList As Worksheet, c As Range
Dim wbDest As Workbook
Set wb = ThisWorkbook
Set wsList = wb.Worksheets("MoveSheet") 'your sheet with tab names and "Move" flag
Set wbDest = Workbooks.Open(Filename:="C:\Example\Path\ReportList.xlsx") 'provide the full path
For Each c In wsList.Range("A1:A" & wsList.Cells(Rows.Count, "A").End(xlUp).Row).Cells
If c.Offset(0, 1).Value = "Move" Then 'has a flag to be moved?
wb.Worksheets(c.Value).Move after:=wbDest.Sheets(wbDest.Sheets.Count) 'move after last sheet
End If
Next c
End Sub
Maybe a for each loop would be good.
Dim wkbk1 As Workbook - Main workbook
Dim wkbk2 As Workbook - Your other workbook
Set wkbk1 = ActiveWorkbook
Set wkbk2 = "input name here"
Dim ws As Worksheet
For Each ws In wkbk1.Sheets
'use if code to check if certain Criteria met'
ws.Move wkbk2.Sheets(Sheets.Count)
Next ws
I would have one loop to run through column A and check if the sheet needs to be move by checking the column B right alongside it. If column B contains the trigger, which would be checked with a if condition, then move the sheet to another workbook.
For i = 1 To Sheets("Sheet1").Range("A1").End(xlDown).Row
If Sheets("sheet1").Range("B" & i) = "Yes" Then
Sheets(Sheets("sheet1").Range("A" & i)).Move After:=Workbooks("Otherworkbook.xls").Sheets(1)
Else
End If
Next i
Something like this but might need to declare the second workbook with the full filename and directory.

Making sheet name the same as cell value

I am currently working on macro in a workbook with multiple worksheets, that aims to show and hide certain worksheets based on the values in a master worksheet. The worksheet names are also contained in the master worksheet and the main procedure looks at these values when referencing to a worksheet it needs to show or hide. The problem with this method is that, the macro will produce errors if the user changes the worksheet tab names. I was hoping to insert an additional procedure that makes the tab names of each worksheet equal to the values in the respective cell of the master worksheet. I came up with the following:
Sub SheetName()
If Not ActiveWorkbook Is ThisWorkbook Then Exit Sub
Dim DataImport As Worksheet
Set DataImport = ThisWorkbook.Worksheets("Data Import")
DataImport.Range("A13").Value = Sheet1.Name
End Sub
This code works fine but there are about 100+ worksheets in this workbook. I was wondering if there is a more efficient way to do this, as opposed to typing the same procedure 100 times. I've tried storing the worksheet code names in an array and looping the same procedure through the array, for example:
Sub test()
Dim DataImport As Worksheet
Set DataImport = ThisWorkbook.Worksheets("Data Import")
Dim index As Long
Dim ws(0 To 2) As Worksheet
Set ws = Array(Sheet1, Sheet2, Sheet3)
For i = 13 To 14
index = i - 13
DataImport.Cells(i, "A").Value = ws(index).Name
Next i
End Sub
but the error message "Can't Assign to Array" shows up. Sorry in advance if my code looks garbage, I am still new to VBA and I still have quite a lot to learn.
If you list the sheet codenames in ColA of your master sheet, then this code will update columns B and C with the current sheet tab names and indexes respectively:
Sub UpdateIndex()
Dim ws As Worksheet, cn As String, m
For Each ws In ThisWorkbook.Worksheets
cn = ws.CodeName
If cn <> DataImport.CodeName Then
'look for the codename in the Import sheet
m = Application.Match(cn, DataImport.Columns(1), 0)
If Not IsError(m) Then
'got a match - update this row
DataImport.Cells(m, "B").Value = ws.Name 'tab name
DataImport.Cells(m, "C").Value = ws.Index 'sheet index
End If
End If
Next ws
End Sub
Assumes you set the code name for your "Data Import" worksheet to DataImport.
If your code is driven by the sheet codename, it doesn't matter whether the user renames the tabs or changes the sheet order.
For your second attempt, you can use Excel built-in Sheets object and Workbook.Sheets collection:
Sub test()
Dim DataImport As Worksheet
Set DataImport = ThisWorkbook.Worksheets("Data Import")
Dim index As Long
Dim ws As Excel.Sheets
Set ws = ThisWorkbook.Sheets
For i = 13 To 14
index = i - 13
DataImport.Cells(i, "A").Value = ws(index).Name
Next i
End Sub

Copy one worksheet to multiple identical workbooks using VBA

I have a workbook containing one worksheet ("DB Output" or Sheet 34) which I would like to copy to several (around 45) files in within the same folder.
None of the target files have an existing sheet named "DB Output" - the objective is to find a way to insert a copy of this sheet, forumlas and all, into each one.
The range of cells on that sheet that needs to be copied to a sheet of the same name in each book is A1:PE5
The sheet contains references to cells in the book it is currently in, however as the files which I am seeking to copy the worksheet to all share the same template, I want the references to be to the local file, not the original one.
I've tried looking at RDBMerge, however it seems that is for merging sheets, and while I do want to do that, it will not help me do it multiple times quickly.
Likewise I have looked on SO for similar situations, this is the closest, however my attempts to adapt that code have failed as I only have a single workskeet. Never the less, as it is always useful to inlcude what you have already tried, here is my existing attempt:
Option Explicit
Public Sub splitsheets()
Dim srcwb As Workbook, trgwb As Workbook
Dim ws As Worksheet, t1ws As Worksheet
Dim rng1 As Range
Dim trgnm As String
Dim fpath As String
Application.ScreenUpdating = False
'--> Set this to the location of the target workbooks
fpath = "C:/file/path/"
Set srcwb = ThisWorkbook
For Each ws In srcwb.Worksheets
trgnm = ws.Name
'--> Change A1:B3 to the range to be copied to inside page
Set rng1 = srcwb.Sheets(trgnm).Range("A1:PE5")
Set trgwb = Workbooks.Open(fpath & trgnm & ".xlsm")
With trgwb
Set t1ws = .Sheets("DB Output")
End With
'--> Change A1:B3 to the range where you want to paste
rng1.Copy t1ws.Range("A1:PE5")
trgwb.Close True
Next
Application.ScreenUpdating = True
End Sub
However this starts with the first sheet in the workbook that contains DB Output (the sheet to be copied) and gives an error that "NameOfSheet1.xlsm" does not exist in that directory (which it does not).
Any help is much appreciated.
This should copy from the active workbook to all files in a directory. If you need help modifying it to fit your specific use let me know!
Edit: fixed code to only copy A1:PE5 and save each workbook.
Sub Example()
Dim path As String
Dim file As String
Dim wkbk As Workbook
path = "C:\Test\"
file = Dir(path)
Application.DisplayAlerts = False
Do While Not file = ""
Workbooks.Open (path & file)
Set wkbk = ActiveWorkbook
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "DB Output"
ThisWorkbook.Sheets("DB Output").Range("A1:PE5").Copy Destination:=wkbk.Sheets("DB Output").Range("A1")
wkbk.Save
wkbk.Close
file = Dir
Loop
Application.DisplayAlerts = True
End Sub
Please note that I did not add error handling so this could break if the active workbook is included in the directory you are trying to copy or if a sheet with the same name already exists in the workbook. If this is an issue let me know and I will add error handling.

Copy sheet and get resulting sheet object?

Is there any easy/short way to get the worksheet object of the new sheet you get when you copy a worksheet?
ActiveWorkbook.Sheets("Sheet1").Copy after:=someSheet
It turns out that the .Copy method returns a Boolean instead of a worksheet object. Otherwise, I could have done:
set newSheet = ActiveWorkbook.Sheets("Sheet1").Copy after:=someSheet
So, I wrote some 25 lines of code to get the object. List all sheets before the copy, list all sheets after, and figure out which one is in the second list only.
I am looking for a more elegant, shorter solution.
Dim sht
With ActiveWorkbook
.Sheets("Sheet1").Copy After:= .Sheets("Sheet2")
Set sht = .Sheets(.Sheets("Sheet2").Index + 1)
End With
I believe I have finally nailed this issue - it's been driving me nuts, also! It really would have been nice if MS made Copy return a sheet object, same as the Add method...
The thing is, the index which VBA allocates a newly copied sheet is actually not determined... as others have noted, it very much depends on hidden sheets. In fact, I think the expression Sheets(n) is actually interpreted as "the nth visible sheet". So unless you write a loop testing every sheet's visible property, using this in code is fraught with danger, unless the workbook is protected so users cannot mess with sheets visible property. Too hard...
My solution to this dilemma is:
Make the LAST sheet visible (even if temporary)
Copy AFTER that sheet. It MUST have index Sheets.Count
Hide the former last sheet again, if required - it will now have
index Sheets.Count-1
Move the new sheet to where you really want it.
Here's my code - which now seems to be bullet-proof...
Dim sh as worksheet
Dim last_is_visible as boolean
With ActiveWorkbook
last_is_visible = .Sheets(.Sheets.Count).Visible
.Sheets(Sheets.Count).Visible = True
.Sheets("Template").Copy After:=.Sheets(Sheets.Count)
Set sh=.Sheets(Sheets.Count)
if not last_is_visible then .Sheets(Sheets.Count-1).Visible = False
sh.Move After:=.Sheets("OtherSheet")
End With
In my case, I had something like this (H indicating a hidden sheet)
1... 2... 3(H)... 4(H)... 5(H)... 6... 7... 8(H)... 9(H)
.Copy After:=.Sheets(2) actually creates a new sheet BEFORE the next
VISIBLE sheet - ie, it became the new index 6. NOT at index 3, as you might expect.
Hope that helps ;-)
Another solution I used would be to copy the sheet to a place where you know its index, aka first. There you can easily have a reference to it for whatever you need, and after that you can move it freely to where you want.
Something like this:
Worksheets("Sheet1").Copy before:=Worksheets(1)
set newSheet = Worksheets(1)
newSheet.move After:=someSheet
UPDATE:
Dim ThisSheet As Worksheet
Dim NewSheet As Worksheet
Set ThisSheet = ActiveWorkbook.Sheets("Sheet1")
ThisSheet.Copy
Set NewSheet = Application.ActiveSheet
Updated with suggestions from Daniel Labelle:
To handle possible hidden sheets, make the source sheet visible, copy it, use the ActiveSheet method to return the reference to the new sheet, and reset the visibility settings:
Dim newSheet As Worksheet
With ActiveWorkbook.Worksheets("Sheet1")
.Visible = xlSheetVisible
.Copy after:=someSheet
Set newSheet = ActiveSheet
.Visible = xlSheetHidden ' or xlSheetVeryHidden
End With
I realise this post is over a year old, but I came here looking for an answer to the same issue regarding copying sheets and unexpected results caused by hidden sheets. None of the above really suited what I wanted mainly because of the structure of my workbook. Essentailly it has a very large number of sheets and what is displayed is driven by a user selecting the specific functionality, plus the order of the visible sheets was importnat to me so i didnt want to mess with those. So my end solution was to rely on Excels default naming convention for copied sheets, and explictly rename the new sheet by name. Code sample below (as an aside, my workbook has 42 sheets and only 7 are permanently visible, and the
after:=Sheets(Sheets.count) put my copied sheet in the middle of the 42 sheets, depending on what sheets are visible at the time.
Select Case DCSType
Case "Radiology"
'Copy the appropriate Template to a new sheet at the end
TemplateRAD.Copy after:=Sheets(Sheets.count)
wsToCopyName = TemplateRAD.Name & " (2)"
'rename it as "Template"
Sheets(wsToCopyName).Name = "Template"
'Copy the appropriate val_Request to a new sheet at the end
valRequestRad.Copy after:=Sheets(Sheets.count)
'rename it as "val_Request"
wsToCopyName = valRequestRad.Name & " (2)"
Sheets(wsToCopyName).Name = "val_Request"
Case "Pathology"
'Copy the appropriate Template to a new sheet at the end
TemplatePath.Copy after:=Sheets(Sheets.count)
wsToCopyName = TemplatePath.Name & " (2)"
'rename it as "Template"
Sheets(wsToCopyName).Name = "Template"
'Copy the appropriate val_Request to a new sheet at the end
valRequestPath.Copy after:=Sheets(Sheets.count)
wsToCopyName = valRequestPath.Name & " (2)"
'rename it as "val_Request"
Sheets(wsToCopyName).Name = "val_Request"
End Select
Anyway, posted just in case its useful to anyone else
This question is really old, but as there were some activity here not so long time ago and it still gave me all the answers I needed 10 years later, I'd like to share the way I did it.
After reading this thread, I found Tigregalis'answer really interesting, even if I prefer Ama's solution. But none of them was reflecting original Excel behavior with the choice of copying before/after or to a new workbook. As I needed it, I wrote down my own function, and to make it still closer from Excel's one, I made it able to handle Sheets and not just Worksheets.
For those interested, here is my code :
Function CopySheet(ByVal InitSh As Object, Optional ByVal BeforeSh As Object, Optional ByVal AfterSh As Object) As Object
'Excel doesn't provide any reliable way to get a pointer to a newly copied sheet. This function allows to make it
'Arguments: - InitSh : The sheet we want to copy
' - BeforeSh : The sheet before the one we want the copy to be placed
' - AfterSh : The sheet after the one we want the copy to be placed
'Return : - Returns the newly copied sheet. If BeforeSh and AfterSh are not givent to the sub, the sheet is created in a new workbook. In the case both are given, BeforeSh is used
' To beknown : if the InitSh is not visible, the new one won't be visible except if InitWks is the first of the workbook !
Dim isBefore As Boolean
Dim isAfter As Boolean
Dim Wkb As Workbook
'If there is before or after, we need to know the workbook where the new sheet is copied, if not we need to set up a new workbook
If Not BeforeSh Is Nothing Then
isBefore = True
Set Wkb = BeforeSh.Parent
ElseIf Not AfterSh Is Nothing Then
isAfter = True
Set Wkb = AfterSh.Parent
Else
Set Wkb = Application.Workbooks.Add(xlWBATWorksheet)
End If
'To be able to find the new worksheet, we need to make sure the first sheet of the destination workbook is visible and make the copy before it
Dim FirstWksVisibility As XlSheetVisibility
FirstWksVisibility = Wkb.Sheets(1).Visible
Wkb.Sheets(1).Visible = xlSheetVisible
InitSh.Copy before:=Wkb.Sheets(1)
'Restore the initial visibility of the first worksheet of the workbook, that is now the sheet number 2 as we copied one in front of it
Wkb.Sheets(2).Visible = FirstWksVisibility
'Finaly, move the sheet accordingly to otpional arguments BeforeWks or AfterWks
Dim TempSh As Object
Set TempSh = Wkb.Sheets(1)
If isBefore Then
TempSh.Move before:=BeforeSh
ElseIf isAfter Then
TempSh.Move after:=AfterSh
Else
'If no optional arguments, we made a new workbook and we need to erase the blank worksheet that was created with it if the new sheet is visible (we cant if it's not visible)
If TempSh.Visible = xlSheetVisible Then
Dim Alert As Boolean
Alert = Application.DisplayAlerts
Application.DisplayAlerts = False
Wkb.Sheets(2).Delete
Application.DisplayAlerts = Alert
End If
End If
Set CopySheet = TempSh
End Function
I tried to test my code extensively with worksheets and charts, and I think it does what it was designed for. The only thing to note is that copied sheet won't be visible if the source one was not, EXCEPT if the source one was the first sheet of the workbook.
This should be a comment in response to #TimWilliams, but it's my first post so I can't comment.
This is an example of the problem #RBarryYoung mentioned, related to hidden sheets. There is a problem when you try to put your copy after the last sheet and the last sheet is hidden. It seems that, if the last sheet is hidden, it always retains the highest index, so you need something like
Dim sht As Worksheet
With ActiveWorkbook
.Sheets("Sheet1").Copy After:=.Sheets(.Sheets.Count)
Set sht = .Sheets(.Sheets.Count - 1)
End With
Similar situation when you try to copy before a hidden first sheet.
Based on Trevor Norman's method, I've developed a function for copying a sheet and returning a reference to the new sheet.
Unhide the last sheet (1) if not visible
Copy the source sheet (2) after the last sheet (1)
Set the reference to the new sheet (3), i.e. the sheet after the last sheet (1)
Hide the last sheet (1) if necessary
Code:
Function CopySheet(ByRef sourceSheet As Worksheet, Optional ByRef destinationWorkbook As Workbook) As Worksheet
Dim newSheet As Worksheet
Dim lastSheet As Worksheet
Dim lastIsVisible As XlSheetVisibility
If destinationWorkbook Is Nothing Then Set destinationWorkbook = sourceSheet.Parent
With destinationWorkbook
Set lastSheet = .Worksheets(.Worksheets.Count)
End With
' store visibility of last sheet
lastIsVisible = lastSheet.Visible
' make the last sheet visible
lastSheet.Visible = xlSheetVisible
sourceSheet.Copy After:=lastSheet
Set newSheet = lastSheet.Next
' restore visibility of last sheet
lastSheet.Visible = lastIsVisible
Set CopySheet = newSheet
End Function
This will always insert the copied sheet at the end of the destination workbook.
After this, you can do any moves, renames, etc.
Usage:
Sub Sample()
Dim newSheet As Worksheet
Set newSheet = CopySheet(ThisWorkbook.Worksheets("Template"))
Debug.Print newSheet.Name
newSheet.Name = "Sample" ' rename new sheet
newSheet.Move Before:=ThisWorkbook.Worksheets(1) ' move to beginning
Debug.Print newSheet.Name
End Sub
Or if you want the behaviour/interface to be more similar to the built-in Copy method (i.e. before/after), you could use:
Function CopySheetTo(ByRef sourceSheet As Worksheet, Optional ByRef beforeSheet As Worksheet, Optional ByRef afterSheet As Worksheet) As Worksheet
Dim destinationWorkbook As Workbook
Dim newSheet As Worksheet
Dim lastSheet As Worksheet
Dim lastIsVisible As XlSheetVisibility
If Not beforeSheet Is Nothing Then
Set destinationWorkbook = beforeSheet.Parent
ElseIf Not afterSheet Is Nothing Then
Set destinationWorkbook = afterSheet.Parent
Else
Set destinationWorkbook = sourceSheet.Parent
End If
With destinationWorkbook
Set lastSheet = .Worksheets(.Worksheets.Count)
End With
' store visibility of last sheet
lastIsVisible = lastSheet.Visible
' make the last sheet visible
lastSheet.Visible = xlSheetVisible
sourceSheet.Copy After:=lastSheet
Set newSheet = lastSheet.Next
' restore visibility of last sheet
lastSheet.Visible = lastIsVisible
If Not beforeSheet Is Nothing Then
newSheet.Move Before:=beforeSheet
ElseIf Not afterSheet Is Nothing Then
newSheet.Move After:=afterSheet
Else
newSheet.Move After:=sourceSheet
End If
Set CopySheetTo = newSheet
End Function
It is correct that hidden worksheets cause the new worksheet index to be non-sequential on either side of the source worksheet. I found that Rachel's answer works if you're copying before. But you'd have to adjust it if you're copying after.
Once the model is visible and copied, the new worksheet object is simply the ActiveSheet whether you copy the source before or after.
As a preference, you could replace:
Set newSheet = .Previous with Set newSheet = Application.ActiveSheet.
Hope this is helpful to some of you.
As already mentioned here, copy/paste the sheet to the very left (index = 1), then assign it to a variable, then move it where you would like.
Function CopyWorksheet(SourceWorksheet As Worksheet, AfterDestinationWorksheet As Worksheet) As Worksheet
Dim DestinationWorkbook As Workbook
Set DestinationWorkbook = AfterDestinationWorksheet.Parent
Dim FirstSheetVisibility As XlSheetVisibility
FirstSheetVisibility = DestinationWorkbook.Sheets(1).Visible
DestinationWorkbook.Sheets(1).Visible = xlSheetVisible
SourceWorksheet.Copy Before:=DestinationWorkbook.Sheets(1)
DestinationWorkbook.Sheets(2).Visible = FirstSheetVisibility
Dim NewWorksheet As Worksheet
Set NewWorksheet = DestinationWorkbook.Sheets(1)
NewWorksheet.Move After:=AfterDestinationWorksheet
Set CopyWorksheet = NewWorksheet
End Function
I had the same requirement and came to this thread while looking for an answer. While checking out various options, found that, a easy way to access the new sheet is, using the chain of references that Excel stores (sample below). It seems like Excel maintains a linked list kind of thing w.r.t the sheet references.
'Example:
ActiveWorkbook.Sheets("Sheet1").Copy After:=someSheet
set newSheet = someSheet.Next
Similarly for the sheet inserted 'before' another sheet...
ActiveWorkbook.Sheets("Sheet1").Copy Before:=someSheet
set newSheet = someSheet.Previous
Works even if the source sheet is hidden. If the source sheet is hidden, the worksheet is copied, but the new sheet remains hidden too!
I've been trying to create a reliable generic "wrapper" function for the sheet.Copy method for re-use across multiple projects for years.
I've tried several of the approaches here and I've found only Mark Moore's answer to be a reliable solution across all scenarios. Ie the one using the "Template (2)" name to identify the new sheet.
In my case, any solution using the "ActiveSheet method" was useless as in some instances the target workbook was in a non-Active or hidden Workbook.
Similarly, some of my Workbooks have hidden sheets intermixed with visible sheets in various locations; at the beginning, in the middle, at the end; and therefore I found the solutions using the Before: and After: options also unreliable depending on the ordering of the visible and hidden sheets, along with the additional factor when the source sheet is also hidden.
Therefore after several re-writes, I've ended up with the following wrapper function:
'***************************************************************************
'This is a wrapper for the worksheet.Copy method.
'
'Used to create a copy of the specified sheet, optionally set it's name, and return the new
' sheets object to the calling function.
'
'This routine is needed to predictably identify the new sheet that is added. This is because
' having Hidden sheets in a Workbook can produce unexpected results in the order of the sheets,
' eg when adding a hidden sheet after the last sheet, the new sheet doesn't always end up
' being the last sheet in the Worksheets collection.
'***************************************************************************
Function wsCopy(wsSource As Worksheet, wsAfter As Worksheet, Optional ByVal sNewSheetName As String) As Worksheet
Dim Ws As Worksheet
wsSource.Copy After:=wsAfter
Set Ws = wsAfter.Parent.Sheets(wsSource.Name & " (2)")
'set ws Name if one supplied
If sNewSheetName <> "" Then
Ws.Name = sNewSheetName
End If
Set wsCopy = Ws
End Function
NOTE: Even this solution will have issues if the source sheet's Name is more than 27 chars, as the maximum sheet name is 31, but that is usually under my control.
Old post but wasn't sure about unhiding sheets or adding suffixes to names.
This is my approach:
Sub DuplicateSheet()
Dim position As Integer
Dim wbNewSheet As Worksheet
position = GetFirstVisiblePostion
ThisWorkbook.Worksheets("Original").Copy Before:=ThisWorkbook.Sheets(position)
Set wbNewSheet = ThisWorkbook.Sheets(position)
Debug.Print "Duplicated name:" & wbNewSheet.Name, "Duplicated position:" & wbNewSheet.Index
End Sub
Function GetFirstVisiblePostion() As Integer
Dim wbSheet As Worksheet
Dim position As Integer
For Each wbSheet In ThisWorkbook.Sheets
If wbSheet.Visible = xlSheetVisible Then
position = wbSheet.Index
Exit For
End If
Next
GetFirstVisiblePostion = position
End Function
Wanted to share my simple solution to this with the following code
Sub copy_sheet(insheet As String, newsheet As String)
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Sheets(newsheet).Delete
ThisWorkbook.Sheets(insheet).Copy before:=ThisWorkbook.Sheets(1)
For Each ws In ThisWorkbook.Worksheets
If (InStr(ws.Name, insheet) > 0 And InStr(ws.Name, "(") > 0) Then
ThisWorkbook.Sheets(ws.Name).Name = newsheet
Exit For
End If
Next
Application.DisplayAlerts = True
End Sub
Whenever you copy a sheet, the resulting "copied" sheet ALWAYS has the name of the original sheet, and a bracketed number. As long as none of your original sheets contain bracketed number names, this will work 100% of the time.
It copies the sheet, then loops through all sheet names looking for one that 1) contains the original name and 2) has a bracketed number, and then renames the sheet
I had the same problem as OP, but with the addition of some hidden and very hidden sheets.
Finding the last sheet by using something like
{set last_sheet = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)} does not work because Excel does not count the hidden worksheets, so the position number {last_sheet.Index + 1} is too high and makes an error.
Instead I made a loop to find the position:
Dim w as Workbook, s as Worksheet, template_sheet as worksheet, last_sheet as Worksheet, new_sheet as Worksheet
' find the position of the last sheet
For Each s in w.Workbooks
If s.Visible = xlSheetVisible then
Set last_sheet = s
End if
Next
' make the sheet to be copied visible, copy it and hide it again
w.Worksheets("template_sheet").Visible = xlHidden
w.Worksheets("template_sheet").Copy After:=last_sheet
w.Worksheets("template_sheet").Visible = xlVeryHidden
' reference the new sheet that was just added
Set new_sheet = Worksheets(last_sheet.index + 1)

Resources