Copy several sheets (names in array) from a Workbook to my active open Workbook

BVOPP

New Member
Joined
Feb 9, 2015
Messages
44
I created the below code and it works fine for the first sheet in the array. But when selecting the second sheet it shows an error: Run-time error '1004': Select method of Worksheet class failed

What is the correct code to solve this issue? Thanks in advance for the support!

VBA Code:
Sub SheetGetFromWorkbook3(List_of_Sheets As Variant, message As String)

    Dim ActBook As Workbook
    Dim ExistBook As Workbook
    Dim ActBook_Name As String
    Dim FromBook_Name As String
    Dim NewFileType As String
    Dim X As Integer
    
    Set ActBook = ActiveWorkbook
    ActBook_Name = ActiveWorkbook.Name
    
    NewFileType = "Excel Files 2007 (*.xlsx), *.xlsx," & _
                   "Excel Files 1997-2003 (*.xls), *.xls," & _
                   "Report Files *.xlsm (*.xlsm),"
    
    FileToOpen = Application.GetOpenFilename(Title:=message, FileFilter:=NewFileType)
    If FileToOpen = False Then
        MsgBox "No File Specified.", vbExclamation, "ERROR"
        Exit Sub
    Else
        Set ExistBook = Workbooks.Open(Filename:=FileToOpen)
        FromBook_Name = ActiveWorkbook.Name
    End If
    
        Application.DisplayAlerts = False
 
        For X = LBound(List_of_Sheets) To UBound(List_of_Sheets)
            Workbooks(FromBook_Name).Sheets(List_of_Sheets(X)).Visible = True
  [COLOR=rgb(209, 72, 65)]          Workbooks(FromBook_Name).Sheets(List_of_Sheets(X)).Select[/COLOR]
            Workbooks(FromBook_Name).Sheets(List_of_Sheets(X)).Copy Before:=Workbooks(ActBook_Name).Sheets(1)
        Next X
        Application.DisplayAlerts = True
    
        'suppress saving of the existing workbook and close it
        ExistBook.Saved = True
        ExistBook.Close

End Sub
 

Some videos you may like

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
51,128
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
   For x = LBound(List_of_Sheets) To UBound(List_of_Sheets)
      With ExistBook.Sheets(List_of_Sheets(x))
         .Visible = xlSheetVisible
         .Copy Before:=Workbooks(ActBook_Name).Sheets(1)
      End With
   Next x
 

BVOPP

New Member
Joined
Feb 9, 2015
Messages
44
Wow !!! that works thanks a lot Fluff !!

one additional.. if i would have a 2 dimensional array with also the rename of the several sheets... how would the rename of the sheet work in your code?

Hope i am not to greedy now! ;)
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
51,128
Office Version
  1. 365
Platform
  1. Windows
Try
VBA Code:
   For x = LBound(List_of_Sheets) To UBound(List_of_Sheets)
      With ExistBook.Sheets(List_of_Sheets(x, 1))
         .Visible = xlSheetVisible
         .Copy Before:=Workbooks(ActBook_Name).Sheets(1)
      End With
      Workbooks(ActBook_Name).Sheets(List_of_Sheets(x, 1)).Name = List_of_Sheets(x, 2)
   Next x
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
51,128
Office Version
  1. 365
Platform
  1. Windows
Glad to help & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,119,236
Messages
5,576,896
Members
412,752
Latest member
LUIS SAMANO
Top