How to copy a sheet of a workbook

Question

I try to copy all sheets of a closed workbook and paste it in the workbook I am working with.

I tried following code:

Sub copy_Ws()
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim sourceWb As Workbook
    Dim sh As Worksheet: Set sh = wb.Worksheets(1)
    Dim sourceWs As Worksheet
    
    Dim cell As Range: Set cell = sh.Range("C1:C50")
    Dim currentCell As Range
    Dim filename As String
    Dim sourceWbName As String
    Dim path As String

        
    For Each currentCell In cell
    If IsEmpty(currentCell) = False Then
        On Error Resume Next
        Set sourceWb = Workbooks(currentCell.Value)
        Debug.Print (currentCell.Value)
        For Each ws In sourceWb.Sheets
            ' Copy the worksheet
            ws.Copy After:=wb.Sheets(wb.Sheets.Count)
        Next ws
        On Error GoTo 0
    End If
    Next currentCell
    
End Sub

Just that you know in the currentCell are the paths saved.

My problem is that I get something like Index out of bounds 9 and the compiler is showing me following line "Set sourceWb = Workbooks(currentCell.Value)"

What can I do to get the needed workbook?

Thank you in advance

Answer 1

Import All Worksheets From Multiple Files in a List

• When a file is open, you create a reference to it by using its name (not its path!), e.g.:

  Set wb = Workbooks("Test.xlsx")
  

• When a file is closed, you need to use the Open method to open it and create a reference to it by using its path, e.g.:

  Set wb = Workbooks.Open("C:\Test\Test.xlsx")
  

Sub ImportWorkSheets()
' Charts:
' To also allow importing charts, replace:
'     'sws As Worksheet' with 'sws As Object' (there is no 'Sheet' object) and
'     '... In swb.Worksheets' with '... In swb.Sheets'
' I would also replace 'sws' with 'ssh'.
' Hidden:
' If a sheet is hidden it will be copied hidden.
' If a sheet is very hidden, it will not be copied (no alert).
' You could add some code in the 'For Each sws...' loop to modify this behavior.
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook
    Dim dws As Worksheet: Set dws = dwb.Worksheets(1)
    Dim drgList As Range: Set drgList = dws.Range("C1:C50")
    
    Application.ScreenUpdating = False
    
    Dim swb As Workbook, sws As Worksheet, dcell As Range
    Dim swbPath As String, swbName As String, WasWorkbookOpen As Boolean
    
    For Each dcell In drgList.Cells
        swbPath = CStr(dcell.Value)
        If Len(swbPath) > 0 Then ' cell is not blank
            swbName = Dir(swbPath)
            If Len(swbName) > 0 Then ' file (workbook) exists
                On Error Resume Next ' prevent error if file not open
                    Set swb = Workbooks(swbName)
                On Error Resume Next
                If swb Is Nothing Then ' workbook is not open
                    On Error Resume Next ' prevent error if not Excel file
                        Set swb = Workbooks.Open(swbPath)
                    On Error Resume Next
                Else ' workbook is open
                    If StrComp(swb.FullName, swbPath, vbTextCompare) = 0 Then
                    ' workbook from the given location open
                        If swb Is dwb Then ' it's the destination workbook
                            Set swb = Nothing ' reset; remains open
                        Else ' it's not the destination workbook
                            WasWorkbookOpen = True
                        End If
                    Else ' workbook from a different location open!!!
                        MsgBox "A workbook named """ & swb.Name _
                            & """ from another location (""" & swb.path _
                            & """) is open! Cannot process!", vbExclamation
                        Set swb = Nothing ' reset; remains open
                    End If
                End If
                If Not swb Is Nothing Then ' workbook is referenced (set)
                    For Each sws In swb.Worksheets
                        sws.Copy After:=dwb.Sheets(dwb.Sheets.Count)
                    Next sws
                    If WasWorkbookOpen Then ' workbook was open
                        WasWorkbookOpen = False ' reset; remains open
                    Else ' workbook was closed
                        swb.Close SaveChanges:=False ' gets closed
                    End If
                    Set swb = Nothing ' reset
                'Else ' workbook is not referenced (set); do nothing
                End If
            'Else ' file (workbook) doesn't exist; do nothing
            End If
        'Else ' cell is blank; do nothing
        End If
    Next dcell
    
    Application.ScreenUpdating = True
    
    MsgBox "Worksheets imported.", vbInformation
    
End Sub