PDA

View Full Version : Copying sheets using vba



Hnich
05-25-2017, 04:43 PM
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.

mdmackillop
05-25-2017, 05:00 PM
Please post a small sample masterbook with info page , master list etc. relevant to your question.

Hnich
05-26-2017, 05:39 AM
This is the code I made so far. The values in D18:22 are the names of the sheets that need to be copied.



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

mdmackillop
05-26-2017, 06:11 AM
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

Hnich
05-26-2017, 06:15 AM
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?

Hnich
05-26-2017, 06:19 AM
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,

mdmackillop
05-26-2017, 06:43 AM
Note that using numbers for sheet names is not best practice.

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

Hnich
05-26-2017, 06:49 AM
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.

mdmackillop
05-26-2017, 07:34 AM
Try

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