Code to copy and paste all data from specified workbook

[Darren Smith]

I need to first clear all worksheets in active workbook.
Then use the listbox item to open a new specified Workbook.
Then copy all the sheets paste to original Workbook then close the workbook down.
Keeping the original workbook open.

Option Explicit
Sub CopySheets()

Dim AutomatedCardworkerWorkbook As Workbook
Dim JobCardMasterWorkbook As Workbook
Dim JobCardMasterWorksheets As Worksheet
Dim Ws As Worksheet
Dim wb As Workbook
Dim strArray As String

For counter = 0 To ListBox3.Items.Count - 1
strArray(counter) = ListBox3.Items(counter)


Set wb = Workbooks(ListBox3.Value)
Set AutomatedCardworkerWorkbook = Workbooks("Automated Cardworker.xlsm")
Set JobCardMasterWorkbook = strArray
Set JobCardMasterWorksheets = JobCardMasterWorkbook.Sheets

Application.DisplayAlerts = False

AutomatedCardworkerWorkbook.Sheets("Job Card Master").Delete
AutomatedCardworkerWorkbook.Sheets("Job Card with Time Analysis").Delete
AutomatedCardworkerWorkbook.Sheets("Check Sheet").Delete
AutomatedCardworkerWorkbook.Sheets("SPEC SHEET").Delete
AutomatedCardworkerWorkbook.Sheets("Electrical inspection").Delete
AutomatedCardworkerWorkbook.Sheets("PRE ASSEMBLY3").Delete
AutomatedCardworkerWorkbook.Sheets("TOOLPOD").Delete
AutomatedCardworkerWorkbook.Sheets("FAB SHOP").Delete
AutomatedCardworkerWorkbook.Sheets("STOCK LIST").Delete
AutomatedCardworkerWorkbook.Sheets("ORDER LIST").Delete
AutomatedCardworkerWorkbook.Sheets("PRE-DEL").Delete
AutomatedCardworkerWorkbook.Sheets("WOOD SHOP").Delete
AutomatedCardworkerWorkbook.Sheets("Electrical load analysis").Delete

For Each Ws In JobCardMasterWorkbook.Sheets
   Ws.Copy After:=AutomatedCardworkerWorkbook.Sheets(AutomatedCardworkerWorkbook.Sheets.Count)
 
Next Ws
Application.DisplayAlerts = True

End Sub

 

[Darren Smith]

I did have them all deleting yesterday?

 

[Darren Smith]

Yes but where are the wb names stored... in the VBA code or elsewhere? Dave

In the VBA code. Shall i send the code to you.

 

[NdNoviceHlp]

U can post the code related to loading the listbox. Are the wb names unique... do you have more than 1 file with the same name stored in different locations? Dave

 

[Darren Smith]

U can post the code related to loading the listbox. Are the wb names unique... do you have more than 1 file with the same name stored in different locations? Dave

Yes all files are unique names.
listbox additems
Private Sub UserForm_Initialize()

With Me.ListBox3

ListBox3.AddItem "1 Page Job Card Master.xlsm"
ListBox3.AddItem "2 Page Job Card Master.xlsm"
ListBox3.AddItem "3 Page Job Card Master.xlsm"
ListBox3.AddItem "4 Page Job Card Master.xlsm"
ListBox3.AddItem "5 Page Job Card Master.xlsm"

End With

End Sub

 

[NdNoviceHlp]

Ok I'll kick it around for a bit and post back. Dave

 

[Darren Smith]

Dave

This code opens the workbook if that helps


Private Sub ListBox3_Click()

For i = 0 To Me.ListBox3.ListCount - 1

If Me.ListBox3.Selected(i) Then

Workbooks.Open "\\TGS-SRV01\Share\ShopFloor\PRODUCTION\DLS Cardworker\Jobcard Templates\" & Me.ListBox3.List(i)

Exit For

End If

Next i

End Sub

 

[NdNoviceHlp]

The wbs are always at this location???
"\\TGS-SRV01\Share\ShopFloor\PRODUCTION\DLS Cardworker\Jobcard Templates\"
I thought U indicated before that was not the case. It would make it very easy if that's the case. Please confirm. Dave

 

[NdNoviceHlp]

OK if the wbs are always at that location, U can trial this. Assumptions, your userform is named Userform1(adjust to suit) and that U always have a sheet called job card master. Please save your wb and trial this code on a copy. HTH. Dave
Userform code....

Option Explicit
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

On Error GoTo ErFix
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Set ObjWorksheet = ThisWorkbook.Worksheets("Job Card Master")
With ObjWorksheet
.Name = "TEMP"
End With
For Each Sht In ThisWorkbook.Sheets
If Sht.Name <> "TEMP" Then
Sht.Delete
End If
Next Sht
Set FSO = CreateObject("Scripting.FilesystemObject")
Set FilDir = FSO.getfile("\\TGS-SRV01\Share\ShopFloor\PRODUCTION\DLS Cardworker\Jobcard Templates\" _
                         & UserForm1.ListBox3.List(UserForm1.ListBox3.ListIndex))
Workbooks.Open Filename:=FilDir
Set PageCollect = New Collection
For Each Sht In Workbooks(FilDir.Name).Sheets
PageCollect.Add Workbooks(FilDir.Name).Sheets(Sht.Name)
Next Sht

For Cnt = 1 To PageCollect.Count
PageCollect(Cnt).Copy ThisWorkbook.Sheets(Cnt)
Next Cnt
Workbooks(FilDir.Name).Close SaveChanges:=False
Set FilDir = Nothing
ThisWorkbook.Worksheets("TEMP").Delete

ErFix:
If Err.Number <> 0 Then
MsgBox "Error"
On Error GoTo 0
End If
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Set FSO = Nothing
End Sub

 

[NdNoviceHlp]

Apologies, I had to leave and that wasn't quite right. I corrected the code and added some comments. Dave

Option Explicit
Private Sub ListBox3_Click()
Dim ObjWorksheet As Object, Sht As Worksheet, ShtCollect As Collection
Dim FSO As Object, FilDir As Object, Cnt As Integer

On Error GoTo ErFix
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
'remove all but one ws
Set ObjWorksheet = ThisWorkbook.Worksheets("Job Card Master")
With ObjWorksheet
.Name = "TEMP"
End With
For Each Sht In ThisWorkbook.Sheets
If Sht.Name <> "TEMP" Then
Sht.Delete
End If
Next Sht
'open selected file
Set FSO = CreateObject("Scripting.FilesystemObject")
Set FilDir = FSO.getfile("C:\yourfoldername\1 Page Job Card Master.xlsm")
Workbooks.Open Filename:=FilDir
'load sheets in collection
Set ShtCollect = New Collection
For Each Sht In Workbooks(FilDir.Name).Sheets
ShtCollect.Add Workbooks(FilDir.Name).Sheets(Sht.Name)
Next Sht
'copy collection sheets to wb
For Cnt = 1 To ShtCollect.Count
ShtCollect(Cnt).Copy ThisWorkbook.Sheets(Cnt)
Next Cnt
'close wb
Workbooks(FilDir.Name).Close SaveChanges:=False
'remove temp sheet
ThisWorkbook.Worksheets("TEMP").Delete

'clean up/manage errors
ErFix:
If Err.Number <> 0 Then
MsgBox "Error"
On Error GoTo 0
End If
Set ObjWorksheet = Nothing
Set FSO = Nothing
Set FilDir = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Set FSO = Nothing
End Sub

 

[Darren Smith]

OK if the wbs are always at that location, U can trial this. Assumptions, your userform is named Userform1(adjust to suit) and that U always have a sheet called job card master. Please save your wb and trial this code on a copy. HTH. Dave
Userform code....

Option Explicit
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

On Error GoTo ErFix
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Set ObjWorksheet = ThisWorkbook.Worksheets("Job Card Master")
With ObjWorksheet
.Name = "TEMP"
End With
For Each Sht In ThisWorkbook.Sheets
If Sht.Name <> "TEMP" Then
Sht.Delete
End If
Next Sht
Set FSO = CreateObject("Scripting.FilesystemObject")
Set FilDir = FSO.getfile("\\TGS-SRV01\Share\ShopFloor\PRODUCTION\DLS Cardworker\Jobcard Templates\" _
                         & UserForm1.ListBox3.List(UserForm1.ListBox3.ListIndex))
Workbooks.Open Filename:=FilDir
Set PageCollect = New Collection
For Each Sht In Workbooks(FilDir.Name).Sheets
PageCollect.Add Workbooks(FilDir.Name).Sheets(Sht.Name)
Next Sht

For Cnt = 1 To PageCollect.Count
PageCollect(Cnt).Copy ThisWorkbook.Sheets(Cnt)
Next Cnt
Workbooks(FilDir.Name).Close SaveChanges:=False
Set FilDir = Nothing
ThisWorkbook.Worksheets("TEMP").Delete

ErFix:
If Err.Number <> 0 Then
MsgBox "Error"
On Error GoTo 0
End If
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Set FSO = Nothing
End Sub

Hi Dave
I`ve tried this and it takes all sheets from workbook Automated Cardworker the replaces them with one page called "Temp". I need all sheets from the other workbooks to fill into Automated Cardworker workbook . I am sorry i should of told you that first 4 sheets in Automated Cardworker should not be deleted. Sorry not sure what you mean by "temp worksheets"? Thanks for your help in advance.