how to stop pop up and can the coding be minimised

P

Patriot2879

Well-known Member
Joined
Feb 1, 2018
Messages
1,259
Office Version
  1. 2010
Platform
  1. Windows
Hi, good morning, i have the code below but i was wondering if there was anything that could be done to make it abit more compact? also is there anyway to stop the pop up of the file?
Code: 
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim lookuprng As Range

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("G:\TEAM\ES_Mtr_Tech_Ops\Customer Management Centre\Utilisation\Complex\Rota\Rolling Rota 2017.xlsx")
wb2.Sheets("Sheet1").Range("C1").Copy wb1.Sheets("ROTA").Range("B2:B27")
wb1.Activate
With wb1.Sheets("ROTA")

End With

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("G:\TEAM\ES_Mtr_Tech_Ops\Customer Management Centre\Utilisation\Complex\Rota\Rolling Rota 2017.xlsx")
wb2.Sheets("Sheet1").Range("D1").Copy wb1.Sheets("ROTA").Range("D2:D27")
wb1.Activate
With wb1.Sheets("ROTA")

End With

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("G:\TEAM\ES_Mtr_Tech_Ops\Customer Management Centre\Utilisation\Complex\Rota\Rolling Rota 2017.xlsx")
wb2.Sheets("Sheet1").Range("E1").Copy wb1.Sheets("ROTA").Range("F2:F27")
wb1.Activate
With wb1.Sheets("ROTA")

End With

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("G:\TEAM\ES_Mtr_Tech_Ops\Customer Management Centre\Utilisation\Complex\Rota\Rolling Rota 2017.xlsx")
wb2.Sheets("Sheet1").Range("F1").Copy wb1.Sheets("ROTA").Range("H2:H27")
wb1.Activate
With wb1.Sheets("ROTA")

End With

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("G:\TEAM\ES_Mtr_Tech_Ops\Customer Management Centre\Utilisation\Complex\Rota\Rolling Rota 2017.xlsx")
wb2.Sheets("Sheet1").Range("G1").Copy wb1.Sheets("ROTA").Range("J2:J27")
wb1.Activate
With wb1.Sheets("ROTA")

End With

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("G:\TEAM\ES_Mtr_Tech_Ops\Customer Management Centre\Utilisation\Complex\Rota\Rolling Rota 2017.xlsx")
wb2.Sheets("Sheet1").Range("H1").Copy wb1.Sheets("ROTA").Range("L2:L27")
wb1.Activate
With wb1.Sheets("ROTA")

End With

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("G:\TEAM\ES_Mtr_Tech_Ops\Customer Management Centre\Utilisation\Complex\Rota\Rolling Rota 2017.xlsx")
wb2.Sheets("Sheet1").Range("I1").Copy wb1.Sheets("ROTA").Range("N2:N27")
wb1.Activate
With wb1.Sheets("ROTA")

End With

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("G:\TEAM\ES_Mtr_Tech_Ops\Customer Management Centre\Utilisation\Complex\Rota\Rolling Rota 2017.xlsx")
wb2.Sheets("Sheet1").Range("J1").Copy wb1.Sheets("ROTA").Range("P2:P27")
wb1.Activate
With wb1.Sheets("ROTA")

End With

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("G:\TEAM\ES_Mtr_Tech_Ops\Customer Management Centre\Utilisation\Complex\Rota\Rolling Rota 2017.xlsx")
wb2.Sheets("Sheet1").Range("C2:C27").Copy wb1.Sheets("ROTA").Range("C2:C27")
wb1.Activate
With wb1.Sheets("ROTA")

End With

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("G:\TEAM\ES_Mtr_Tech_Ops\Customer Management Centre\Utilisation\Complex\Rota\Rolling Rota 2017.xlsx")
wb2.Sheets("Sheet1").Range("D2:D27").Copy wb1.Sheets("ROTA").Range("E2:E27")
wb1.Activate
With wb1.Sheets("ROTA")

End With

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("G:\TEAM\ES_Mtr_Tech_Ops\Customer Management Centre\Utilisation\Complex\Rota\Rolling Rota 2017.xlsx")
wb2.Sheets("Sheet1").Range("E2:E27").Copy wb1.Sheets("ROTA").Range("G2:G27")
wb1.Activate
With wb1.Sheets("ROTA")

End With

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("G:\TEAM\ES_Mtr_Tech_Ops\Customer Management Centre\Utilisation\Complex\Rota\Rolling Rota 2017.xlsx")
wb2.Sheets("Sheet1").Range("F2:F27").Copy wb1.Sheets("ROTA").Range("I2:I27")
wb1.Activate
With wb1.Sheets("ROTA")

End With

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("G:\TEAM\ES_Mtr_Tech_Ops\Customer Management Centre\Utilisation\Complex\Rota\Rolling Rota 2017.xlsx")
wb2.Sheets("Sheet1").Range("G2:G27").Copy wb1.Sheets("ROTA").Range("K2:K27")
wb1.Activate
With wb1.Sheets("ROTA")

End With

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("G:\TEAM\ES_Mtr_Tech_Ops\Customer Management Centre\Utilisation\Complex\Rota\Rolling Rota 2017.xlsx")
wb2.Sheets("Sheet1").Range("H2:H27").Copy wb1.Sheets("ROTA").Range("M2:M27")
wb1.Activate
With wb1.Sheets("ROTA")

End With

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("G:\TEAM\ES_Mtr_Tech_Ops\Customer Management Centre\Utilisation\Complex\Rota\Rolling Rota 2017.xlsx")
wb2.Sheets("Sheet1").Range("I2:I27").Copy wb1.Sheets("ROTA").Range("O2:O27")
wb1.Activate
With wb1.Sheets("ROTA")

End With

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("G:\TEAM\ES_Mtr_Tech_Ops\Customer Management Centre\Utilisation\Complex\Rota\Rolling Rota 2017.xlsx")
wb2.Sheets("Sheet1").Range("J2:J27").Copy wb1.Sheets("ROTA").Range("Q2:Q27")
wb1.Activate
With wb1.Sheets("ROTA")

End With

End Sub
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Sort by date Sort by votes
You seem to be trying to open the same workbook over and over, which I assume is the popup you are referring to. Try this instead:

Code: 
Private Sub CommandButton1_Click()
    Dim wsTo As Worksheet
    Dim wb2 As Workbook
    Application.ScreenUpdating = False
    
    Set wsTo = ThisWorkbook.Sheets("ROTA")
    
    Set wb2 = Workbooks.Open("G:\TEAM\ES_Mtr_Tech_Ops\Customer Management Centre\Utilisation\Complex\Rota\Rolling Rota 2017.xlsx")
    
    With wb2.Sheets("Sheet1")
        .Range("C1").Copy wsTo.Range("B2:B27")
        .Range("D1").Copy wsTo.Range("D2:D27")
        .Range("E1").Copy wsTo.Range("F2:F27")
        .Range("F1").Copy wsTo.Range("H2:H27")
        .Range("G1").Copy wsTo.Range("J2:J27")
        .Range("H1").Copy wsTo.Range("L2:L27")
        .Range("I1").Copy wsTo.Range("N2:N27")
        .Range("J1").Copy wsTo.Range("P2:P27")
        .Range("C2:C27").Copy wsTo.Range("C2:C27")
        .Range("D2:D27").Copy wsTo.Range("E2:E27")
        .Range("E2:E27").Copy wsTo.Range("G2:G27")
        .Range("F2:F27").Copy wsTo.Range("I2:I27")
        .Range("G2:G27").Copy wsTo.Range("K2:K27")
        .Range("H2:H27").Copy wsTo.Range("M2:M27")
        .Range("I2:I27").Copy wsTo.Range("O2:O27")
        .Range("J2:J27").Copy wsTo.Range("Q2:Q27")
    End With

End Sub
 
Upvote 0
Thats brilliant thank you for your help :), alot neater and quicker now when it runs :). thank you again.
Is there anyway to stop the 'Rolling Rota 2017' excel folder from not to load?
 
Upvote 0
Sorry :) what happens at the moment is i have 2 folders once called ROTA and the other is ROLLING ROTA 2017, in ROTA i copy the data from ROLLING ROTA, but it automatically opens that folder which i dont wat it to, is there any way to still copy the data across but not open the other folder? hope this helps? and thank you again for your time much appreciated.
 
Upvote 0
Your code does not open a folder, but it does open a workbook - is that what you mean? If so, is it ok to just close it again at the end? To do that, just add:

Code: 
wb2.Close False

before the End Sub line.
 
Upvote 0
You must log in or register to reply here.

Similar threads

O
  • Question Question
Creating workbooks for a team of staff
Replies
1
Views
193
HighAndWilder
H
R
  • Question Question
[VBA] - Need to Hide one column and need sum of columns
Replies
0
Views
186
rsolanki
R
J
  • Question Question
Assistance changing VBA code to display as HTML or picture of a selection in Lotus Notes
Replies
2
Views
203
jularobert
J
G
  • Question Question
Copying and pasting between two workbooks
Replies
1
Views
694
rlv01
R
S
  • Question Question
Copy listobject table from one worksheet to another workbook
Replies
2
Views
2K
Alex Blakenburg
A

Forum statistics

Threads
1,223,710
Messages
6,174,019
Members
452,542
Latest member
Bricklin

Share this page

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
Back
Top