Copy Paste block data from a csv into another excel file - excel

is there a way not to select workbook back and forth and copy a block of data efficiently?
this is how I am doing it right now:
Set MyWB = ActiveWorkbook
Set DataWS = MyWB.Worksheets("Data")
Set TermDataRange = DataWS.Range("celltopaste")
Workbooks("data.csv").Activate
Range("A1").CurrentRegion.Copy 'selecting block data
MyWB.Activate
TermDataRange.Select
Selection.PasteSpecial Paste:=xlPasteValues
is there a way without selecting MyWB, then the range?
also, selection.paste feels kind of wierd, I hate copying data to clipboard.
I was hoping for something like:
Workbooks("data.csv").Activate
TermDataRange = Range("A1").CurrentRegion
Thanks for your help

Selecting the range directly is as easy as meshing your three lines together:
Set TermDataRange = ActiveWorkbook.Worksheets("Data").Range("celltopaste")
edited - my mistake - I'd skipped more steps than I thought and was actually condensing three of your lines, rather than two, into one : )
(to be honest I would never normally give a seperate name to ActiveWorkbook itself, unless I needed to refer to it as a workbook later in the code)
Avoiding Copy/Paste is pretty easy. The trick is to make sure that your source range and destination range are the same size and shape - once this is true you can simply use the code
RangeA.Value = RangeB.Value
In your case, your best bet is to measure the size of your data first. e.g.
'give range("A1").current region a name just to make it less unwieldy
CopyRange = Range("A1").CurrentRegion
Datarows = CopyRange.Rows.Count
Datacols = CopyRange.Columns.Count
'set a range of same size starting from TermDataRange to move the values to
set DestRange = Range(TermDataRange, TermDataRange(offset(Datarows -1, Datacolumns -1))
'move values directly rather than via copy-paste
DestRange.Value = CopyRange.Value

Maybe you are looking for something more "clean" like this?
Option Explicit
Sub CopyValueFromSheet()
Dim MyWB As Workbook
Dim DataWS As Worksheet
Dim TermDataRange As Range
Dim OtherWB As Workbook
' To avoid screen flashing
Application.ScreenUpdating = False
Set MyWB = ThisWorkbook
Set DataWS = MyWB.Worksheets("Sheetname")
Set TermDataRange = DataWS.Range("DestinationCell")
Set OtherWB = Workbooks.Open("C:\Users\YourUsername\Desktop\CsvFileName.csv")
' When opening a csv file there is only one worksheet with the same name as the csv file
OtherWB.Worksheets("CsvFileName").Range("SourceCell").Copy
TermDataRange.PasteSpecial Paste:=xlPasteValues
Application.ScreenUpdating = True
End Sub
Edit:
Another possible way would result in storing the value of the source cell in a VBA variable and then set it to the destination cell, but it will be pretty much the same:
Dim VarValue As String
VarValue = OtherWB.Worksheets("CsvFileName").Range("SourceCell").Value
TermDataRange.Value = VarValue
HTH ;)

Related

Can't set xVar = range from worksheet.cells(numRow, yVarColumn)

I am struggling with proper syntax for setting variables as ranges...
Specifically, I'm testing a function I want to use in an app that creates new profiles and store the data, I will store that data on a hidden sheet, so they can be recalled at run time.
I'm currently construction a userform in order to create a new profile, the profile data needs to be stored to the first free column on the hidden sheet.
(where I will have to create a dynamic namedRange, so that i can use that range to save the associated data, and update the listbox in the userform)
Right now, I'm stumped by this:
Sub TestFindLastFunctions()
Dim wb As Workbook
Set wb = ThisWorkbook
'wb.activate 'shouldn't be neccesary
Dim ws As Worksheet
Set ws = sh_02CRepStorage
'ws.activate 'shoudn't be neccesary
Dim trgtCol As Long
trgtCol = LastColInSheet(ws) + 2
Debug.Print trgtCol ' so far so good
'Cells(1, trgtCol).Select 'another debug check - only works if sheet activated
Dim trgtCell As Range
Set trgtCell = ws.Cells(1, trgtCol) '<------- problem line
Debug.Print trgtCell '<----- prints "" to the immediate window.
End Sub
The LastColInSheet function is copied form Ron de bruin's page: https://www.rondebruin.nl/win/s9/win005.htm it simply returns a column number, in this case: 4.(One problem with it is if the sheet is empty, it returns an error, wondering if this can be fixed with an if statement in the function.)
I've tried many iterations of the problem line, some work but only if the storage sheet is activated, and give an error if not activate or selected, as the sheet will be hidden, I need this to work without activating the sheet, (although I could switch off screen activation?).
But I understand that it is best practice to avoid extraneous selects and activates, how can I just point directly to what I want and save that range into a variable?
It just doesn't seem like it should be so difficult, I must be missing something obvious.
It also seems like it shouldn't need so many lines of code to do something so simple.
I tried some more iterations of the "problem line" after some more searching...
-The real problem was with the debug.print line
Sub TestFindLastFunctions()
Dim wb As Workbook
Set wb = ThisWorkbook
'wb.activate 'shouldn't be neccesary
Dim ws As Worksheet
Set ws = sh_02CRepStorage
'ws.activate 'shoudn't be neccesary
Dim trgtCol As Long
trgtCol = LastColInSheet(ws) + 2
Debug.Print trgtCol ' so far so good
'Cells(1, trgtCol).Select 'debug Only works if already on sheet
Dim trgtCell As Range
'Set trgtCell = ws.Range _
(ws.Cells(1, trgtCol), ws.Cells(1, trgtCol))
' unnecessarily complex, but correct if using .range?
'but works if insisting on range
Set trgtCell = ws.Cells(1, trgtCol) 'back to original
Debug.Print trgtCell.Address '<---problem was here?
End Sub

Question on copying data from one open workbook to another

I am looking to copy a range of data (columns A:M) on a temporary excel worksheet, with a "tmp" prefix into a worksheet designed to crunch all of this data output into a useable report.
Currently, the user will simply manually copy the temporary output into the report making tool, then run the macro.
Is it possible to automate this data input?
Aaron, SO is used for teaching. But, since I got bored, and in case you don't re-post this here, this is an idea of how to accomplish your goal. Keep in mind that with VBA, and probably all other languages, there's 20 different ways to accomplish the same task, but what fits each users unique scenario is what SO likes to resolve. To give you a rolling start and perhaps some motivation...
Option Explicit
Sub CopyStuff()
Dim ws As Worksheet
Dim ws2 As New Worksheet
Dim rngToCopy As Range
Dim ShtName As String
'use ActiveSheet or actual name
Set ws = ActiveSheet
Set rngToCopy = ws.UsedRange.Columns("A:M")
Set ws2 = ThisWorkbook.Worksheets.Add
'gets name for sheet
ShtName = InputBox("Please enter name for Sheet.")
'more properties to fill if needed, or adjust area to copy to
'just an example here
With ws2
.Name = "tmp" & ShtName
rngToCopy.Copy .UsedRange.Columns(.UsedRange.Columns.Count + 1)
End With
'cleanup
Set ws = nothng: Set ws2 = Nothing
Set rngToCopy = Nothing: ShtName = vbNullString
End Sub
Danny,
ExcelVBADude

Copy Data From One Workbook Into Existing Table in Another Workbook

I am able to read another workbook and copy the contents, but when I try to paste into the existing Table - Excel hangs and freezes. If I copy the data into another sheet with no existing Table, then it works fine.
I am using this:
Dim sFound as String
Dim lRow as Long
Dim data_sheet As Worksheet
Dim wb as Workbook
Dim wb_data as Workbook
Set wb = ThisWorkbook
sFound = Dir(ActiveWorkbook.Path & "\data*.csv)
If sFound <> "" Then
Workbooks.Open Filename:=ActiveWorkbook.Path & "\" & sFound
End If
Set wb_data = ActiveWorkbook
Set data_sheet = Sheets("raw data")
lRow=data_sheet.Cells(data_sheet.Rows.Count,2).End(xlUp).Row
data_sheet.Range("A10:V" & lRow).Copy
wb.Sheets("Data").Range("Data[Code]").PasteSpecial
Application.CutCopyMode = False
wb_data.Close
Any assistance in why the paste is causing the hang up in the table would be greatly appreciated.
2018-09-21 Update
I managed to fix the freezing and hanging through a combination of Marucciboy2's post and my own research. I stored the entire raw data set I was copying into a variant variable. Then, I resized the new table I was copying to to be the same length as the raw data. Then I just set that entire data range value the same as the variant variable. I will update this with the code.
I am still having one issue with is figuring out how to copy one particular column or certain range of columns of one table into another table. I can resize the new table just fine. I just don't know how to set one column into a variant variable or if I need to do something else. Then, I don't know how to set the new table column to that variant variable. Again, will have to post code tomorrow.

Excel VBA PasteSpecial not pasting consistently

I have a report which is used to import data relating to jobplans and then creates graphs and stats based on the data. Calculations and graphs are based on tables and the tables are populated by VBA - user selects the file and then VBA checks it matches the expected file format and put everything in the right place.
HOWEVER, the pastespecial part of the code does not paste everything correctly. Specifically there are a number of columns with datevalues and when pasted some of them (not one column or particular rows but seemingly random cells) are not formatted as dates when pasted and therefore are not captured in formulas when I look for job within particular timeframes.
In the source file the all data is 100% saved as a datevalue (if I put a filter on the data, it is all grouped by year and can be expanded to month/day/time + if I use a test cell to do add 1 to the cells that the next date is shown). Once pasted into target sheet then some is still a datevalue but some appears to be text and showing as dd/mm/yyyy hh:mm but being missed from calculation. On these cells if I go onto them press F2 and then Enter then the cell changes to a datevalue (realigns to the right and then gets included in daterange formulas).
Here is the code:
Public Sub importdata()
Dim wb1, wb3 As Workbook
Dim ws1, ws3 As Worksheet
Dim lrow As Long
Dim WOtable As ListObject
Dim searchcell As Range
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("Dashboard")
Set WOtable = ws1.ListObjects("workorder")
WOfile = Application.GetOpenFilename(FileFilter:="Excel Files (*.CSV),*.CSV", Title:="Select Workorder Extract To Be Opened",MultiSelect:=False)
If WOfile = False Then Exit Sub
Set wb3 = Workbooks.Open(WOfile)
Set ws3 = wb3.Sheets(1)
ws3.Range("M:M, O:O, Q:Q").EntireColumn.Delete
If ws3.Range("A1").Value = "jobnumber" And ws3.Range("B1").Value ="jobdesc" And etc etc Then
lrow = ws3.Range("A1").End(xlDown).Row
ws3.Range("A2:O" & lrow).Copy
WOtable.DataBodyRange(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Else: MsgBox ("File selected to import workorder information was not in expected format, please check the file and retry.")
End If
wb3.Close False
End Sub
I have tried to add the following line before copying to force it based on something I saw on google but to no avail:
ws3.Columns("E:K").NumberFormat = "DD/MM/YYYY HH:MM:SS"
Thanks for any help
As discussed in comments, an example usage of pushing the data into a variant array and then pasting it to the destination. A few comments:
Always state what type you want for each variable, comma separated variables on the same line don't all take the last type.
Use with statements to keep code slightly cleaner and reduce the amount of references excel needs to resolve.
As you didn't clear the contents of the table (merely overwrote them) I replicated this behaviour in the code as I assume it is intended.
Edited sub:
Public Sub importdata()
Dim wb1 As Workbook, wb3 As Workbook
Dim ws1 As Worksheet, ws3 As Worksheet
Dim WOtable As ListObject
Dim varTMP As Variant
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("Dashboard")
Set WOtable = ws1.ListObjects("workorder")
WOfile = Application.GetOpenFilename(FileFilter:="Excel Files (*.CSV),*.CSV", Title:="Select Workorder Extract To Be Opened", MultiSelect:=False)
If WOfile = False Then Exit Sub
Set wb3 = Workbooks.Open(WOfile)
Set ws3 = wb3.Sheets(1)
With ws3
.Range("M:M, O:O, Q:Q").EntireColumn.Delete
If .Range("A1").Value = "jobnumber" And .Range("B1").Value ="jobdesc" And etc etc Then
'load data into variant array
varTMP = .Cells(1, 1).CurrentRegion
'If you want to do any data manipulation on the array, do it here
'Paste array
End With
With WOtable.DataBodyRange
Range(.Cells(1, 1), .Cells(0 + UBound(varTMP, 1), 0 + UBound(varTMP, 2))) = varTMP
End With
Else
MsgBox ("File selected to import workorder information was not in expected format, please check the file and retry.")
End If
wb3.Close False
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