Copying sheets using vba

I am trying to create two excel workbooks. One that is a "master" book that, for simplicity has Sheets A, B, C, D, and E. I want to have a second workbook that has a info page, title page and table of contents, I have already created and have all working. On this info page I want to be able to select one or more of the sheets from the master list, have it open that book, copy the page, and then close the master book without editing that book. In reality the master book has well over 100 sheets and the user would be selecting between 30-60 of the sheets to include. I am struggling to get the code to work and any suggestions would be appreciated.

Please post a small sample masterbook with info page , master list etc. relevant to your question.

This is the code I made so far. The values in D18:22 are the names of the sheets that need to be copied.

Code:

---

Sub MoveSheets()
    With ThisWorkbook.Worksheets("Sheet1")
        Dim Value As String
        Workbooks.Open "C:\Users\HNichols\Documents\Bid Package Manual Testing\FAKE CSI CODE PAGE.xlsm"
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Windows("TOC TESTING.xlsm").Activate
        Value = (D18:22)
        Windows("FAKE CSI CODE PAGE.xlsm").Activate
        Sheets("Value").Copy After:=Workbooks("TOC TESTING.xlsm").Sheets(1)
        Workbooks("C:\Users\HNichols\Documents\Bid Package Manual Testing\FAKE CSI CODE PAGE.xlsm").Close SaveChanges:=False
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

---

Code:

---

Sub MoveSheets1()
Dim wbTOC As Workbook
Dim wbFake As Workbook
Dim Selected As Range
Dim cel As Range


Set Selected = Selection
If Selected(1) = "" Then Exit Sub


Application.ScreenUpdating = False
Application.DisplayAlerts = False


Set wbFake = Workbooks.Open("C:\Users\HNichols\Documents\Bid Package Manual Testing\FAKE CSI CODE PAGE.xlsm")
Set wbTOC = Workbooks("TOC TESTING.xlsm")
 
 For Each cel In Selection
    wbFake.Sheets(cel.Value).Copy After:=wbTOC.Sheets(1)
 Next cel
 wbFake.Close False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

---

Thank you for your help, it says on ln 20 that the subscript is out of range. What do you think the fix to that would be?

Attachment 19297


Here is a simple version of the title page I have been working on. Like I mentioned the list is the names of the sheets in the other workbook. Currently there is just a one in cell A1 for all of the sheets in the other workbook,

Note that using numbers for sheet names is not best practice.

Code:

---

    For Each cel In Selected
        wbFake.Sheets(CStr(cel.Value)).Copy After:=wbTOC.Sheets(1)
    Next cel

---

That is working perfect. Thank you so much. Now my last question is, is there a simple way to make it check box selection instead of having to highlight the cells desired? Thank you again.

Try

Code:

---

Sub MoveSheets1()
    Dim wbTOC As Workbook
    Dim wbFake As Workbook
    Dim Selected As Range
    Dim cel As Range
    Dim i As Long
    Dim TOC As Worksheet
    Dim cb As OLEObject
     
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    Set TOC = ActiveSheet
    Set Selected = TOC.Range("D18:D21")
   
    Set wbFake = Workbooks.Open("C:\Users\HNichols\Documents\Bid Package Manual Testing\FAKE CSI CODE PAGE.xlsm")
    Set wbTOC = Workbooks("TOC TESTING.xlsm")
   
    For i = 1 To 4
        Set ole = TOC.OLEObjects("Checkbox" & i)
        If ole.Object.Value = True Then
            wbFake.Sheets(CStr(Selected(i).Value)).Copy After:=wbTOC.Sheets(1)
        End If
    Next i
   
    wbFake.Close False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

---