Excel template - evaluate a function only once, upon file creation - excel

Our bookkeeper has an Excel template she uses for creating new purchase orders. She wants to make it so that when she creates a new spreadsheet from this template it will generate a new random number in the purchase order number cell only once.
To minimize the chances of two order numbers being the same I was thinking about using a timestamp as a seed rather than an actual random number, like this: =(NOW()-DATE(1970, 1, 1)) * 864 (I know this won't make a proper Unix timestamp, as that doesn't matter, I just wanted it to be shorter).
My main question is, how can I put a formula into a cell and make sure it evaluates only one time, when a new file is created from this template?

Sample code that you should be able to modify and play around with:
Sub tgr()
Dim wb As Workbook
Dim wbNew As Workbook 'Only used if copying template sheet to a brand new workbook
Dim wsTemplate As Worksheet
Dim wsNew As Worksheet
Set wb = ActiveWorkbook
Set wsTemplate = wb.Sheets("Template") 'Change this to the actual name of your template worksheet
'If copying the template to a new sheet in same workbook
wsTemplate.Copy After:=wb.Sheets(wb.Sheets.Count)
Set wsNew = ActiveSheet
'If copying the template to a brand new workbook, leave commented out if not using
'Set wbNew = Workbooks.Add
'wsTemplate.Copy Before:=wbNew.Sheets(1)
'Set wsNew = wbNew.ActiveSheet
'Code here to remove blank sheets from the new workbook if desired
'wsNew.Name = "Actual Sheet Name" 'Update the name of this newly created sheet
With wsNew.Range("A1") 'Change to the actual cell that needs to only have its calculation occur once
.Calculate 'Update the calculation
.Value = .Value 'Convert so that the cell only shows its value and is no longer a formula
End With
End Sub

Related

How can I add sheets from an excel file to another?

So I am trying to write a Macro for Excel, that adds 2 worksheets from an excel file to a new one.
Therefore, I try this:
Sub addfile()
Dim sheet1 As Worksheet
Dim sheet2 As Worksheet
Set sheet1 = Sheets.Add(Type:="C:\Users\Helge\AppData\Roaming\Microsoft\Templates\page1.xltx")
Set sheet2 = Sheets.Add(Type:="C:\Users\Helge\AppData\Roaming\Microsoft\Templates\page2.xltx")
End Sub
When I test it, it imports the first page, but the 2nd page gives me a Runtime error 1004.
Why does this happen?
And is there another way to get 2 sheets from one excel file to another via vba?
Much to my surprise this version of your code actually worked for me.
Sub addfile()
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Set Sheet1 = Sheets.Add(Type:=Environ("Userprofile") & "\OneDrive\Desktop\Template1.xltx")
Set Sheet2 = Sheets.Add(Type:=Environ("Userprofile") & "\OneDrive\Desktop\Book2.xlsx")
Debug.Print Sheet1.Name, Sheet2.Name
End Sub
The reason for my surprise is that Sheet1 and Sheet2 are the default CodeName for the first and second worksheets in any workbook. Therefore there is a conflict of naming between the Sheet1 in the workbook and the Sheet1 you declare which should come to the surface not later than Debug.Print Sheet1.Name. In fact, it may have. I didn't check which name was printed. But the code didn't crash. Since it crashes on your computer, perhaps you have an older version of Excel. Try to stay clear of variable names that Excel also uses. Or there is something wrong with the path & file name, which is hard to tell in that syntax and therefore kept me fooled for quite some time too.
In fact, I discovered the above only after finding out that my Desktop was on OneDrive and not before I had written the function below which is designed to avoid the use of Sheets.Add. It also has some extras such as being able to specify the sheet to take from the template (you could have one template with 2 or more sheets). You can specify an index number or a sheet name. And the function will give a name to the copy, too, if you specify one.
Private Function AddWorksheet(ByVal Template As String, _
TabId As Variant, _
Optional ByVal TabName As String) As Worksheet
Dim Wb As Workbook
Dim Path As String
Dim FileName As String
Set Wb = ThisWorkbook ' change to suit
' make sure the path ends on "\"
Path = "C:\Users\Helge\AppData\Roaming\Microsoft\Templates\"
With Workbooks.Open(Path & Template)
.Sheets(TabId).Copy After:=Wb.Sheets(Wb.Sheets.Count)
.Close
End With
Set AddWorksheet = ActiveSheet
If Len(TabName) Then ActiveSheet.Name = TabName
End Function
You can call the function from a sub routine like this:-
Sub AddWorksheets()
Dim Tab1 As Worksheet
Dim Tab2 As Worksheet
Application.ScreenUpdating = False
Set Tab1 = AddWorksheet("Page1.xltx", 1, "New Tab")
Set Tab2 = AddWorksheet("Page2.xltx", "Sheet1", "Another new Tab")
Application.ScreenUpdating = True
End Sub
Please observe the difference between the two function calls.

Copy from one workbook to another using loop

I have developed the below code however it shows me the error here Runtime error 9 and 13. When it comes to part that the macro should copy data from one workbook to another. I know that I wrongly assigned the variables but no clue how to change it.
Workbooks(wbk).Worksheets(FieldBVal).Range("A1:V1000").Copy Workbooks(recon).Worksheets(FieldAVal).Range("B2")
Just shortly what the macro should do. It should simply copy sheets from one workbook to another. Each sheet refers to one company so it has to be past to another workbook also to the worksheet with the same name of the company. Therefore, I have decided to put name of sheets into excel where is macro. It can happen copmpanies will be added , removed so the user can easily change the name of worksheets or add the new one (without knowing macro structure) but unfortunately sth doesnt work. Can anyone help me out?
Code:
Sub Copy data()
Workbooks.Open Range("A10").Value
For Each wb In Application.Workbooks
If wb.Name Like "*Reconciliation*" Then
wb.Activate
Exit For
End If
Next wb
Set wbk = Workbooks(Range("A9").Value)
Set recon = Workbooks(Range("A11").Value)
Sheets("Macro").Select
Range("B6").Select
Dim i As Integer
Dim FieldAVal As String
Dim FieldBVal As String
Dim Iter As Integer
Iter = Cells(1, 3).Value
For i = 1 To Iter
FieldAVal = Cells(i + 5, 2).Value
FieldBVal = Cells(i + 5, 3).Value
'SAP code to be executed for each row
Workbooks(wbk).Worksheets(FieldBVal).Range("A1:V1000").Copy Workbooks(recon).Worksheets(FieldAVal).Range("B2") here shows error
Next i
End Sub
Set your logic before you start writing code. Start by writing Option Explicit at the top of your blank code module.
It seems, you have a workbook called like "Reconciliation". It seems that you want to call this workbook Wb. Therefore your first line of code should be
Dim Wb As Workbook ' the reconciliation workbook
It appears that somewhere in that workbook there are cells A9 and A11. Where? On a worksheet. Which worksheet? That leads you to the second line of code.
Dim Ws As Worksheet ' the worksheet from which to gather company info
Continue like that until you have identified each part of your project by its nature (workbook, worksheet, string, number), by its function in your project (supplier of data, receiver of data, helper), and given it a name.
Set wbk = Workbooks(Range("A9").Value)
Set recon = Workbooks(Range("A11").Value)
creates two workbook objects. You haven't declared them and give no indication of their function in your project. But it's clear that your code will fail if the ranges A9 and A11 don't hold the names of open workbooks. They must be open because your code doesn't open them, even if the cells hold full file names with their respective paths.
Observe that both A9 and A11 are on the ActiveSheet. That is so because you don't specify any sheet in particular. The ActiveSheet will be any sheet in the object Wb with a name like "Reconciliation" that happens to be active at the time - a very vague description. Chances that the correct sheet will be found are quite slim.
All of this confusion is due to the lack of planning before you started to write code. Go back and start over. Think in much smaller steps than you have done until now. However, one step that you don't have to think is what to Select or Activate. The answer is uniformly "Nothing". Wb.Worksheets("MySheet 1").Cells(9, "A") is a very clear address. VBA can find it. It can obtain its Value, its RowHeight, its Formula and change any of these and more just as soon as it can Select or Activate it. Activating and selecting is an action the user needs. VBA or Excel don't.
And, before I forget, VBA addresses range by name and cells by their coordinates. Range("A9") is a work-around to use a synthetic name for a range which is a single cell. Nothing good will ever come of such acrobatics. Since you already mastered the syntax for addressing cells, stick with it for that purpose. Use names to address ranges of several cells but bear in mind that names like "A1:C7" are artificially constructed from cell coordinates. It's a great system but, alas, the lowest rung on that particular ladder. You can do much more with real names that you create and manage yourself.
thanks for the feedback but there is still the error when it comes to the part copy and paste. I named sheets and workbooks but this combination below doesnt work.
Workbooks(wbk1).Worksheets(ws1).Range("A1:V1000").Copy Workbooks(wbk2).Worksheets(ws2).Range("B2")
Sub CopyData()
Dim i As Integer
Dim FieldAVal As String
Dim FieldBVal As String
Dim FieldCVal As String
Dim FieldDVal As String
Dim wbk1 As Workbook
Dim wbk2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Iter As Integer
Dim recon As Workbook
Dim FilePath As String
FilePath = ThisWorkbook.Worksheets("Macro").Cells(11, 1)
Set recon = Workbooks(FilePath)
Workbooks.Open Range("A10").Value
recon.Activate
Iter = Cells(1, 3).Value
For i = 1 To Iter
FieldAVal = Cells(i + 14, 2).Value
FieldBVal = Cells(i + 15, 3).Value
FieldCVal = Cells(i + 16, 4).Value
FieldDVal = Cells(i + 17, 5).Value
Set wbk1 = Workbooks(FieldDVal)
Set wbk2 = Workbooks(FieldCVal)
Set ws1 = wbk1.Sheets(FieldBVal)
Set ws2 = wbk2.Sheets(FieldAVal)
Workbooks(wbk1).Worksheets(ws1).Range("A1:V1000").Copy Workbooks(wbk2).Worksheets(ws2).Range("B2")
Next i
End Sub

Change excel sheet reference from numerical sequence to sheet name

I have a relatively simple question. Currently I have some code that is working well but not efficient. I have about 500 cost centres each with their own workbook which I have consolidated into a central repository (reference - Wb2 in code below). The code copies ranges from each open template (Wb1) into my consolidation (Wb2). Sample code below (full code not necessary).
Option Explicit
Sub CopyData()
Dim Wb1 As Workbook, wb2 As Workbook, wB As Workbook
Dim rngToCopy1 As Range
Dim rngToCopy2 As Range
Dim rngToCopy3 As Range
Dim rngToCopy4 As Range
Dim rngToCopy5 As Range
Set wb2 = ThisWorkbook
Application.Calculation = xlManual
For Each wB In Application.Workbooks
If Not Left(wB.Name, 18) = "Consolidation Test" Then
Set Wb1 = wB
Exit For
End If
Next
'Forecast Data
With Wb1.Sheets(1)
Set rngToCopy1 = .Range("A11:O11", .Cells(.Rows.Count, "A").End(xlUp))
End With
wb2.Sheets(7).Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(rngToCopy1.Rows.Count, 15).Value = rngToCopy1.Value
wb2.Sheets(7).Range("P" & Rows.Count).End(xlUp).Offset(1).Resize(rngToCopy1.Rows.Count).Value = Sheets(3).Range("J1").Value
I have tried to simply change as an example wB2.Sheets(7) to Wb2.Sheets("Forecast_Data") as well as the original name in VBE wB2.Sheets("Sheet4") but I get a subscript out of range error?
In addition to the solution, please also provide background on why the fix is not so simple, has it got to do with how my variables are declared?
I think #GSerg already gave you the most important hint.
I assume you created a workbook with the name WB2, but it does not contain any of those sheets you want to write in.
Either create them manually in your template (WB2) or have a look at How to Add a Named Sheet at the end of all excel sheets to create them with your VBA.

Vba coding for pulling data through vlookup to master sheer from different worksheet with different tabs

Hi i am new for vba coding
Suppose there is a master sheet name "MDS" and there is a different workbook with different tabs like
Aon
Pge
Hilton
Hsbc
So i need to pull the data through vlook up in mastersheet of that particular tab
If i put aon it fetch aon data. Same goes with other client
Can you please help me with ths
If you have a Vlookup formula that references a different workbook, such as this:
=VLOOKUP(A1,[testOne.xlsx]Sheet1!$A$1:$B$5,2,0)
This would be the equivalent using VBA:
Sub UseVlookup_VBA()
Dim wb As Workbook, sh As Worksheet, rng As Range
Set wb = Workbooks("testOne.xlsx")
Set sh = wb.Sheets("Sheet1")
Set rng = sh.Range("A1:B5")
Range("C1") = Application.WorksheetFunction.VLookup(Range("A1"), rng, 2, 0)
End Sub

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