how to stop pop up and can the coding be minimised

P

Patriot2879

Well-known Member
Joined
Feb 1, 2018
Messages
1,227
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

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
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
Do you folder or file?
 
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

G
  • Question
Copying and pasting between two workbooks
Replies
1
Views
508
rlv01
R
S
  • Question
Copy listobject table from one worksheet to another workbook
Replies
2
Views
951
Alex Blakenburg
A
Z
  • Solved
Userform not adding data to destination file
Replies
3
Views
364
NdNoviceHlp
NdNoviceHlp
B
  • Solved
Object variable or with block variable not set
Replies
2
Views
535
Bagsy
B
Z
  • Question
VBA code to create a new workbook from multiple sheets of current workbook
Replies
9
Views
2K
Micron
M

Forum statistics

Threads
1,214,972
Messages
6,122,530
Members
449,088
Latest member
RandomExceller01

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