Results 1 to 7 of 7

Thread: [RESOLVED] Copy Worksheet from One Workbook to another

  1. #1

    Thread Starter
    Junior Member
    Join Date
    Apr 2009
    Posts
    23

    Resolved [RESOLVED] Copy Worksheet from One Workbook to another

    How can I copy a worksheet from another workbook to my active workbook?

  2. #2
    Addicted Member
    Join Date
    Mar 2009
    Posts
    157

    Re: Copy Worksheet from One Workbook to another

    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?

  3. #3

    Thread Starter
    Junior Member
    Join Date
    Apr 2009
    Posts
    23

    Re: Copy Worksheet from One Workbook to another

    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.

  4. #4
    Addicted Member
    Join Date
    Mar 2009
    Posts
    157

    Re: Copy Worksheet from One Workbook to another

    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?

  5. #5

    Thread Starter
    Junior Member
    Join Date
    Apr 2009
    Posts
    23

    Re: Copy Worksheet from One Workbook to another

    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.

  6. #6

    Thread Starter
    Junior Member
    Join Date
    Apr 2009
    Posts
    23

    Re: Copy Worksheet from One Workbook to another

    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.

  7. #7
    Addicted Member
    Join Date
    Mar 2009
    Posts
    157

    Re: Copy Worksheet from One Workbook to another

    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:

    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
    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
    
    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
    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width