excelvbacopyworksheet

How to copy a sheet of a workbook


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


Solution

  • Import All Worksheets From Multiple Files in a List

    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