This code will not open the required worksheet selection in the listbox. I`ve underlined the code that`s failing below

Darren Smith

Active Member
Joined
Nov 23, 2020
Messages
370
Office Version
  1. 2019
Platform
  1. Windows

This code will not open the required workbook selection in the listbox. I`ve underlined the code that`s failing below​

Rich (BB code):
Private Sub ListBox3_Click()

    Dim ObjWorksheet As Object, Sht As Worksheet, PageCollect As Collection
    Dim FSO As Object, X As Object, FilDir As Object, Fil As Object, Cnt As Integer
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Dim ws As Worksheet
  
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
  
    Set FSO = CreateObject("Scripting.FilesystemObject")
    Set wkbDest = Workbooks("Automated Cardworker.xlsm")
    Set wkbSource = FSO.GetFile("\\TGS-SRV01\Share\ShopFloor\PRODUCTION\DLS Cardworker\Jobcard Templates\" _
                         & UserForm1.ListBox3.List(UserForm1.ListBox3.ListIndex))

  Do While wkbDest.Sheets.Count > 4
        wkbDest.Sheets(wkbDest.Sheets.Count).Delete
    Loop



    Workbooks.Open Filename:=wkbSource
Set PageCollect = New Collection
For Each Sht In Workbooks(wkbSource.Name).Sheets
PageCollect.Add Workbooks(wkbSource.Name).Sheets(Sht.Name)
Next Sht

For Cnt = 1 To PageCollect.Count
PageCollect(Cnt).Copy wkbSource.Sheets(Cnt)
Next Cnt
Workbooks(wkbSource.Name).Close SaveChanges:=False
Set wkbSource = Nothing
wkbDest.Worksheets(ObjWorksheet).Delete


Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True



Set FSO = Nothing

End Sub
 

Some videos you may like

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,463
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
You can't use GetFile to open a workbook. You need to use Workbooks.Open
 

Darren Smith

Active Member
Joined
Nov 23, 2020
Messages
370
Office Version
  1. 2019
Platform
  1. Windows
Thanks for that
The code above is not copying over tabs from specified workbook to "Automated coardworker" can you help me.
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,463
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
Assuming you want to copy the actual sheets themselves:

VBA Code:
  Do While wkbDest.Sheets.Count > 4
        wkbDest.Sheets(wkbDest.Sheets.Count).Delete
    Loop
    Set wkbSource =Workbooks.Open("\\TGS-SRV01\Share\ShopFloor\PRODUCTION\DLS Cardworker\Jobcard Templates\" _
                         & UserForm1.ListBox3.List(UserForm1.ListBox3.ListIndex))

For Each Sht In Workbooks(wkbSource.Name).Sheets
   Sht.Copy After:=wkbDest.Sheets(wkbDest.Sheets.Count)
Next Sht

wkbSource.Close SaveChanges:=False
 

Darren Smith

Active Member
Joined
Nov 23, 2020
Messages
370
Office Version
  1. 2019
Platform
  1. Windows
All working fine
Thankyou very much sorry to be so thick
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,463
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
Not at all - glad we could help. :)
 
Solution

Watch MrExcel Video

Forum statistics

Threads
1,127,567
Messages
5,625,568
Members
416,118
Latest member
kamil_tuncer

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top