How can I copy a worksheet from another workbook to my active workbook?
Printable View
How can I copy a worksheet from another workbook to my active workbook?
Is the other workbook open or closed, or will you not know? Also, do you know where you want to copy the sheet to--I mean, do you know if you want to copy it before or after a particular sheet in the active workbook?
The source workbook will not necessarily be open. Placement in the active workbook is open as I have already written VBA macros to use the copied worksheet and eventually remove it from the active sheet. Thank you.
Ok, and again, do you care where in the active workbook the copied sheet gets put (i.e. do you want it before the first sheet in the workbook, after the last sheet, or someplace else?)
Also, will the workbook you're copying from always be the same workbook stored in the same location, or could it be different each time?
The copied sheet should be placed before the first sheet in the active workbook. The workbook being copied from will always be the same name and found in the same location. It will not be open. Thank you for your help.
The copied sheet should be placed before the first sheet in the active workbook. The workbook being copied from will always be the same name and found in the same location. It will not be open. Thank you for your help.
I like to put functions in their own module (just to keep things organized), so if I were you, I'd create a new module to paste the following code into:
Then, here is a sample procedure (which, again for organizational sake, would be in a separate module from the code pasted above), which shows how to call the functions defined above from a procedure:Code:Option Explicit 'force declaration of variables
'PUBLIC VARIABLES-----------------------------------------------------------------------------
'FUNCTIONS------------------------------------------------------------------------------------
Public Function CopySheet(ByVal sWbName As String, ByVal sPath As String, _
ByVal sShtName As String, iPlace As Integer, iIndex As Integer) As Boolean
'---Function Description/Notes----------------------------------------------------------------
'This function will open the workbook from which you want to copy the worksheet, will copy
'the sheet, then will close the workbook. The function will return TRUE if the copy was
'completed successfully, and will return FALSE if the copy was not completed successfully.
'If an error occurs opening the workbook or copying the worksheet, you will be presented
'with a message box about the error.
'You will need to provide the name of the workbook to copy from (sWbName), the path of
'that workbook (sPath), the name of the sheet to copy (sShtName), whether you want the
'copied sheet placed before or after a sheet (before=0, after=1) and the index of the
'sheet in the activeworkbook before/after which you want the sheet copied.
'---Variable Declarations---------------------------------------------------------------------
Dim iResp As Integer
Dim wbCurrent As Workbook
Dim wbCopyFrom As Workbook
Dim wkbk As Variant
Dim bFound As Boolean
'---Variable Initializations------------------------------------------------------------------
Set wbCurrent = ActiveWorkbook
bFound = False 'initialize boolean to false = Not Found
'---Code--------------------------------------------------------------------------------------
Application.ScreenUpdating = False 'don't need to watch stuff opening and closing
'check to make sure provided file name has an extension
If GetFileExtension(sWbName) = "FALSE" Then 'no file extension was provided
GoTo e1
Else 'the file name has an extension
'check to make sure the path provided ends in the directory separator; fix if not
If Right(sPath, 1) <> Application.PathSeparator Then
sPath = sPath & Application.PathSeparator
End If
'Check if the workbook to copy from is already open
For Each wkbk In Application.Workbooks
If wkbk.Name = sWbName Then
Set wbCopyFrom = wkbk 'save workbook to copy from
bFound = True 'True, workbook is already open
End If
Next wkbk
On Error GoTo e2 'turn on error handler e2 in case problems opening specified workbook
If bFound = False Then 'workbook is not already open, must open it
'The first 'True' below indicates that links should be updated in the workbook to open
'If you do not want links updated, change the first True to False. The other True
'makes the workbook open as read-only. That should not need to be changed.
Set wbCopyFrom = Workbooks.Open(sPath & sWbName, True, True)
End If
On Error GoTo e3 'switch to e3 error handler in case of problems copying the worksheet
If iPlace = 0 Then 'place sheet BEFORE index sheet
wbCopyFrom.Sheets(sShtName).Copy BEFORE:=wbCurrent.Sheets(iIndex)
Else 'place sheet AFTER index sheet
wbCopyFrom.Sheets(sShtName).Copy AFTER:=wbCurrent.Sheets(iIndex)
End If
If bFound = False Then 'we opened the workbook, must now close it
wbCopyFrom.Close (False) 'False = do not save changes
End If
End If
Exit Function
e1:
iResp = MsgBox("The filename provided to this function must include the file extension.", vbOKOnly + vbCritical, "Error:")
CopySheet = False
Exit Function
e2:
iResp = MsgBox("Error finding workbook to copy from. Please check the file name and path provided in the VBA code.", vbOKOnly + vbCritical, "Error:")
CopySheet = False
Exit Function
e3:
iResp = MsgBox("Error copying worksheet. Please verify the worksheet name, sheet index, and placement provided in the VBA code.", vbOKOnly + vbCritical, "Error:")
CopySheet = False
End Function
Public Function GetFileExtension(ByVal FileName As String) As String
'---Function Description/Notes----------------------------------------------------------------
'This function will find the file extension for any given name. If no file extension is
'found in the file name, "FALSE" is returned. This can also be done using a
'filesystemobject, however, I'm not sure what the support is like for it among platforms
'---Variable Declarations---------------------------------------------------------------------
Dim arrChars() As String
Dim i As Integer
Dim j As Integer
'---Code--------------------------------------------------------------------------------------
j = 1 'counter for number of characters captured
For i = Len(FileName) To 1 Step -1
ReDim Preserve arrChars(1 To j)
arrChars(j) = Left(Right(FileName, i), 1) 'save file name one letter at a time
j = j + 1
Next i
j = 0
For i = 1 To UBound(arrChars) 'loop through the characters in the file name
If arrChars(i) = "." Then
j = i 'j will always have the largest character index where a '.' is found
End If
Next i
GetFileExtension = "" 'file extension starts as nothing
If j = 0 Then
GetFileExtension = "FALSE" 'no file extension exists in the file name provided
Else
For i = j To UBound(arrChars) 'loop through the characters starting with the last '.'
GetFileExtension = GetFileExtension & arrChars(i)
Next i
End If
End Function
The code should be bug-free, but no guarantees... I've tried to comment the code thoroughly so you can see how and why everything is done, so you can modify it on your own.Code:Option Explicit
Sub ExampleSub()
'---Procedure Description/Notes---------------------------------------------------------------
'This is a sample procedure showing the use of the function 'CopySheet'
'---Variable Declarations---------------------------------------------------------------------
'file name of workbook from which you want to copy a sheet
Dim sCopyFromWbName As String
'path where sCopyFromWbName is located
Dim sCopyFromPath As String
'name of the sheet you want to copy
Dim sCopyFromShtName As String
'whether you want the sheet put before or after the sheet with index iPutCopyHere
Dim iPutBeforeAfter As Integer '0 = Before, 1 = After
'where you want the sheet copied
Dim iPutCopyHere As Integer '(will place relative to this sheet index)
'---Variable Initializations------------------------------------------------------------------
sCopyFromWbName = "CopyFromMe.xls" 'be sure to include the extension in the filename
sCopyFromPath = "C:\Documents and Settings\Username\Desktop\" 'file path
sCopyFromShtName = "CopyMe" 'name of sheet to copy
iPutBeforeAfter = 0 'will place before sheet
iPutCopyHere = 1 'will place relative to first sheet
'---Code--------------------------------------------------------------------------------------
'...your code here
'...
'Copy the sheet
Call CopySheet(sCopyFromWbName, sCopyFromPath, sCopyFromShtName, iPutBeforeAfter, _
iPutCopyHere)
'...rest of your code here
'...
End Sub