Optimize/ Simplify Macro

L

lightkerosene

New Member
Joined
Sep 30, 2015
Messages
15
Code: 
Sub Import()
Application.ScreenUpdating = False
'Import basic stuff
'Network
Sheet8.Range("U2:U3001") = Sheet3.Range("AB2:AB3001").Value
'Network Addon
Sheet2.Range("I5:I3004") = Sheet8.Range("V2:V3001").Value
'FAN
Sheet2.Range("B5:B3004") = Sheet3.Range("A2:A3001").Value
'BAN
Sheet2.Range("C5:C3004") = Sheet3.Range("E2:E3001").Value
'Phone Number
Sheet2.Range("D5:D3004") = Sheet3.Range("Q2:Q3001").Value
'End Date
Sheet2.Range("E5:E3004") = Sheet3.Range("I2:I3001").Value
'Make
Sheet2.Range("F5:F3004") = Sheet3.Range("AC2:AC3001").Value
'Model
Sheet2.Range("G5:G3004") = Sheet3.Range("AD2:AD3001").Value
'User
Sheet2.Range("H5:H3004") = Sheet3.Range("P2:P3001").Value
'Primary Line
Sheet2.Range("Q5:Q3004") = Sheet3.Range("X2:X3001").Value
'Minutes
Sheet2.Range("AQ5:AQ3004") = Sheet3.Range("AK2:AK3001").Value
'Data
Sheet2.Range("AR5:AR3004") = Sheet3.Range("AL2:AL3001").Value

'DragFormulas Paste
'Copy Row 2 to Row 3 through last data in Column U
     With Sheets("Macro Settings")
        .Rows("2:2").Copy
        .Rows("3:" & Range("U2").End(xlDown).Row).PasteSpecial
     End With
'International
Sheet2.Range("X5:X3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("AZ5:AZ3004") = Sheet8.Range("A2:A3001").Value
'Insuarance
Sheet2.Range("Y5:Y3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BA5:BA3004") = Sheet8.Range("A2:A3001").Value
'Enhanced Push to Talk
Sheet2.Range("AA5:AA3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BC5:BC3004") = Sheet8.Range("A2:A3001").Value
'AT&T MDM
Sheet2.Range("AB5:AB3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BDZ5:BD3004") = Sheet8.Range("A2:A3001").Value
'Forms
Sheet2.Range("AC5:AC3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BE5:BE3004") = Sheet8.Range("A2:A3001").Value
'Toggle
Sheet2.Range("AD5:AD3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BF5:BF3004") = Sheet8.Range("A2:A3001").Value
'MRAS
Sheet2.Range("AE5:AE3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BG5:BG3004") = Sheet8.Range("A2:A3001").Value
'Comet
Sheet2.Range("AF5:AF3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BH5:BH3004") = Sheet8.Range("A2:A3001").Value
'Airwatch
Sheet2.Range("AI5:AI3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BK5:BK3004") = Sheet8.Range("A2:A3001").Value
'AprivaPay
Sheet2.Range("AG5:AG3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BI5:BI3004") = Sheet8.Range("A2:A3001").Value
'Big Tin Can
Sheet2.Range("AL5:AL3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BN5:BN3004") = Sheet8.Range("A2:A3001").Value
'Box
Sheet2.Range("AM5:AM3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BO5:BO3004") = Sheet8.Range("A2:A3001").Value
'OAH
Sheet2.Range("AN5:AN3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BP5:BP3004") = Sheet8.Range("A2:A3001").Value
'Office Direct
Sheet2.Range("AO5:AO3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BQ5:BQ3004") = Sheet8.Range("A2:A3001").Value
'Access My LAN
Sheet2.Range("Z5:Z3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BB5:BB3004") = Sheet8.Range("A2:A3001").Value
'Business Messaging
Sheet2.Range("AP5:AP3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BR5:BR3004") = Sheet8.Range("A2:A3001").Value
'Xora
Sheet2.Range("AK5:AK3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BM5:BM3004") = Sheet8.Range("A2:A3001").Value
'TeleNAV
Sheet2.Range("AJ5:AJ3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BL5:BL3004") = Sheet8.Range("A2:A3001").Value
'Unlimited Data
Sheet2.Range("X5:X3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("AZ5:AZ3004") = Sheet8.Range("A2:A3001").Value
Application.ScreenUpdating = True
End Sub

So basically it is a copy paste very specific stuff. But it takes like 30 minutes to do a 10 line account. Is there a way to optimize this.. I was thinking for example:

Sheet2.Range("B5", Range("A2".End(xlDown)) = Sheet3.Range("A2", Range("A2".End(xlDown)).Value

But I have no idea how to write it correctly and make it work for this many copy pastes.

Any Ideas would be appreciated.
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
Sort by date Sort by votes
IS the sheet recalculating as it goes ?
Try turning off calculation as well

at the beginning use
Code: 
with Application
.ScreenUpdating = False
.Calculation=xlCalculationManual
end with

and at the end
Code: 
with Application
.ScreenUpdating = False
.Calculation=xlCalculationAutomatic
end with
 
Upvote 0
Michael M said:
IS the sheet recalculating as it goes ?
Try turning off calculation as well

at the beginning use
Code: 
with Application
.ScreenUpdating = False
.Calculation=xlCalculationManual
end with

and at the end
Code: 
with Application
.ScreenUpdating = False
.Calculation=xlCalculationAutomatic
end with
Click to expand...



There is a part in the code that needs to calculate. but it made it faster. Do you have an example of how to write the overall code?
'DragFormulas Paste
'Copy Row 2 to Row 3 through last data in Column U
With Sheets("Macro Settings")
.Rows("2:2").Copy
.Rows("3:" & Range("U2").End(xlDown).Row).PasteSpecial
End With
 
Upvote 0
The calculations that would occur from copying formulas can wait.
You have 50 value transfers at 3000 cells each, plus the x number of formulas, netting a change to over 150,000 cells
But each time you "copy" those values, your VBA goes back to the source range. Instead load each Range/array into a variable.

Code: 
Dim Array1 As Variant

Array1 = sheet8.Range("A2:A3001").Value2

Sheet2.Range("X5:X3004").Value = Array1
 
Upvote 0
lightkerosene said:
Code: 
'International
Sheet2.Range("X5:X3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("AZ5:AZ3004") = Sheet8.Range("A2:A3001").Value
'Insuarance
Sheet2.Range("Y5:Y3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BA5:BA3004") = Sheet8.Range("A2:A3001").Value
'Enhanced Push to Talk
Sheet2.Range("AA5:AA3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BC5:BC3004") = Sheet8.Range("A2:A3001").Value
'AT&T MDM
Sheet2.Range("AB5:AB3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BDZ5:BD3004") = Sheet8.Range("A2:A3001").Value
'Forms
Sheet2.Range("AC5:AC3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BE5:BE3004") = Sheet8.Range("A2:A3001").Value
'Toggle
Sheet2.Range("AD5:AD3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BF5:BF3004") = Sheet8.Range("A2:A3001").Value
'MRAS
Sheet2.Range("AE5:AE3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BG5:BG3004") = Sheet8.Range("A2:A3001").Value
'Comet
Sheet2.Range("AF5:AF3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BH5:BH3004") = Sheet8.Range("A2:A3001").Value
'Airwatch
Sheet2.Range("AI5:AI3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BK5:BK3004") = Sheet8.Range("A2:A3001").Value
'AprivaPay
Sheet2.Range("AG5:AG3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BI5:BI3004") = Sheet8.Range("A2:A3001").Value
'Big Tin Can
Sheet2.Range("AL5:AL3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BN5:BN3004") = Sheet8.Range("A2:A3001").Value
'Box
Sheet2.Range("AM5:AM3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BO5:BO3004") = Sheet8.Range("A2:A3001").Value
'OAH
Sheet2.Range("AN5:AN3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BP5:BP3004") = Sheet8.Range("A2:A3001").Value
'Office Direct
Sheet2.Range("AO5:AO3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BQ5:BQ3004") = Sheet8.Range("A2:A3001").Value
'Access My LAN
Sheet2.Range("Z5:Z3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BB5:BB3004") = Sheet8.Range("A2:A3001").Value
'Business Messaging
Sheet2.Range("AP5:AP3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BR5:BR3004") = Sheet8.Range("A2:A3001").Value
'Xora
Sheet2.Range("AK5:AK3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BM5:BM3004") = Sheet8.Range("A2:A3001").Value
'TeleNAV
Sheet2.Range("AJ5:AJ3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BL5:BL3004") = Sheet8.Range("A2:A3001").Value
'Unlimited Data
Sheet2.Range("X5:X3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("AZ5:AZ3004") = Sheet8.Range("A2:A3001").Value
Click to expand...
Just double checking... are the ranges shown to the right of the equal sign intentionally all the same, Sheet8.Range("A2:A3001")?
 
Upvote 0
lightkerosene said:
The cells are the right areas and such
Click to expand...
Not entirely. In the section from you code below, I marked in red a letter that I think should be deleted. Also, the last two assignments can be deleted because they are identical to the first two assignments.
Code: 
'International
Sheet2.Range("X5:X3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("AZ5:AZ3004") = Sheet8.Range("A2:A3001").Value
'Insuarance
Sheet2.Range("Y5:Y3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BA5:BA3004") = Sheet8.Range("A2:A3001").Value
'Enhanced Push to Talk
Sheet2.Range("AA5:AA3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BC5:BC3004") = Sheet8.Range("A2:A3001").Value
'AT&T MDM
Sheet2.Range("AB5:AB3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BD[COLOR="#FF0000"][B][SIZE=3]Z[/SIZE][/B][/COLOR]5:BD3004") = Sheet8.Range("A2:A3001").Value
'Forms
Sheet2.Range("AC5:AC3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BE5:BE3004") = Sheet8.Range("A2:A3001").Value
'Toggle
Sheet2.Range("AD5:AD3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BF5:BF3004") = Sheet8.Range("A2:A3001").Value
'MRAS
Sheet2.Range("AE5:AE3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BG5:BG3004") = Sheet8.Range("A2:A3001").Value
'Comet
Sheet2.Range("AF5:AF3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BH5:BH3004") = Sheet8.Range("A2:A3001").Value
'Airwatch
Sheet2.Range("AI5:AI3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BK5:BK3004") = Sheet8.Range("A2:A3001").Value
'AprivaPay
Sheet2.Range("AG5:AG3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BI5:BI3004") = Sheet8.Range("A2:A3001").Value
'Big Tin Can
Sheet2.Range("AL5:AL3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BN5:BN3004") = Sheet8.Range("A2:A3001").Value
'Box
Sheet2.Range("AM5:AM3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BO5:BO3004") = Sheet8.Range("A2:A3001").Value
'OAH
Sheet2.Range("AN5:AN3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BP5:BP3004") = Sheet8.Range("A2:A3001").Value
'Office Direct
Sheet2.Range("AO5:AO3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BQ5:BQ3004") = Sheet8.Range("A2:A3001").Value
'Access My LAN
Sheet2.Range("Z5:Z3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BB5:BB3004") = Sheet8.Range("A2:A3001").Value
'Business Messaging
Sheet2.Range("AP5:AP3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BR5:BR3004") = Sheet8.Range("A2:A3001").Value
'Xora
Sheet2.Range("AK5:AK3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BM5:BM3004") = Sheet8.Range("A2:A3001").Value
'TeleNAV
Sheet2.Range("AJ5:AJ3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BL5:BL3004") = Sheet8.Range("A2:A3001").Value
'Unlimited Data
Sheet2.Range("X5:X3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("AZ5:AZ3004") = Sheet8.Range("A2:A3001").Value

And, if I am not mistaken, the following single line of code can replace all of the above quoted lines of code...

Code: 
[table="width: 500"]
[tr]
	[td]Intersect(Rows("5:3004"), Range("X:AG,AJ:AP,AZ:BI,BK:BK,BN:BQ").EntireColumn) = Sheet8.Range("A2:A3001").Value[/td]
[/tr]
[/table]

I'll look at the rest of your code later, but I just wanted to point out the above for now.
 
Upvote 0
Rick Rothstein said:
Not entirely. In the section from you code below, I marked in red a letter that I think should be deleted. Also, the last two assignments can be deleted because they are identical to the first two assignments.
Code: 
'International
Sheet2.Range("X5:X3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("AZ5:AZ3004") = Sheet8.Range("A2:A3001").Value
'Insuarance
Sheet2.Range("Y5:Y3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BA5:BA3004") = Sheet8.Range("A2:A3001").Value
'Enhanced Push to Talk
Sheet2.Range("AA5:AA3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BC5:BC3004") = Sheet8.Range("A2:A3001").Value
'AT&T MDM
Sheet2.Range("AB5:AB3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BD[COLOR=#FF0000][B][SIZE=3]Z[/SIZE][/B][/COLOR]5:BD3004") = Sheet8.Range("A2:A3001").Value
'Forms
Sheet2.Range("AC5:AC3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BE5:BE3004") = Sheet8.Range("A2:A3001").Value
'Toggle
Sheet2.Range("AD5:AD3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BF5:BF3004") = Sheet8.Range("A2:A3001").Value
'MRAS
Sheet2.Range("AE5:AE3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BG5:BG3004") = Sheet8.Range("A2:A3001").Value
'Comet
Sheet2.Range("AF5:AF3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BH5:BH3004") = Sheet8.Range("A2:A3001").Value
'Airwatch
Sheet2.Range("AI5:AI3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BK5:BK3004") = Sheet8.Range("A2:A3001").Value
'AprivaPay
Sheet2.Range("AG5:AG3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BI5:BI3004") = Sheet8.Range("A2:A3001").Value
'Big Tin Can
Sheet2.Range("AL5:AL3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BN5:BN3004") = Sheet8.Range("A2:A3001").Value
'Box
Sheet2.Range("AM5:AM3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BO5:BO3004") = Sheet8.Range("A2:A3001").Value
'OAH
Sheet2.Range("AN5:AN3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BP5:BP3004") = Sheet8.Range("A2:A3001").Value
'Office Direct
Sheet2.Range("AO5:AO3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BQ5:BQ3004") = Sheet8.Range("A2:A3001").Value
'Access My LAN
Sheet2.Range("Z5:Z3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BB5:BB3004") = Sheet8.Range("A2:A3001").Value
'Business Messaging
Sheet2.Range("AP5:AP3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BR5:BR3004") = Sheet8.Range("A2:A3001").Value
'Xora
Sheet2.Range("AK5:AK3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BM5:BM3004") = Sheet8.Range("A2:A3001").Value
'TeleNAV
Sheet2.Range("AJ5:AJ3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BL5:BL3004") = Sheet8.Range("A2:A3001").Value
'Unlimited Data
Sheet2.Range("X5:X3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("AZ5:AZ3004") = Sheet8.Range("A2:A3001").Value

And, if I am not mistaken, the following single line of code can replace all of the above quoted lines of code...

Code: 
[TABLE="width: 500"]
<tbody>[TR]
[TD]Intersect(Rows("5:3004"), Range("X:AG,AJ:AP,AZ:BI,BK:BK,BN:BQ").EntireColumn) = Sheet8.Range("A2:A3001").Value[/TD]
[/TR]
</tbody>[/TABLE]

I'll look at the rest of your code later, but I just wanted to point out the above for now.
Click to expand...


You just opened my eyes. It is putting all of those as A2:A3001. But that wouldn't be the reason it isn't showing just the reason that it isnt copying the right stuff over, which I was going to look at tomorrow at work.
 
Upvote 0
Code: 
Sub Import()


Application.ScreenUpdating = False
'Import basic stuff
'Network
Sheet8.Range("U2:U3001") = Sheet3.Range("AB2:AB3001").Value
'Network Addon
Sheet2.Range("I5:I3004") = Sheet8.Range("V2:V3001").Value
'FAN
Sheet2.Range("B5:B3004") = Sheet3.Range("A2:A3001").Value
'BAN
Sheet2.Range("C5:C3004") = Sheet3.Range("E2:E3001").Value
'Phone Number
Sheet2.Range("D5:D3004") = Sheet3.Range("Q2:Q3001").Value
'End Date
Sheet2.Range("E5:E3004") = Sheet3.Range("I2:I3001").Value
'Make
Sheet2.Range("F5:F3004") = Sheet3.Range("AC2:AC3001").Value
'Model
Sheet2.Range("G5:G3004") = Sheet3.Range("AD2:AD3001").Value
'User
Sheet2.Range("H5:H3004") = Sheet3.Range("P2:P3001").Value
'Primary Line
Sheet2.Range("Q5:Q3004") = Sheet3.Range("X2:X3001").Value
'Minutes
Sheet2.Range("AQ5:AQ3004") = Sheet3.Range("AK2:AK3001").Value
'Data
Sheet2.Range("AR5:AR3004") = Sheet3.Range("AL2:AL3001").Value




'DragFormulas Paste
'Copy Row 2 to Row 3 through last data in Column U
     With Sheets("Macro Settings")
        .Rows("2:2").Copy
        .Rows("3:" & Range("U2").End(xlDown).Row).PasteSpecial
     End With
'International
Sheet2.Range("X5:X3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("AZ5:AZ3004") = Sheet8.Range("A2:A3001").Value
'Insuarance
Sheet2.Range("Y5:Y3004") = Sheet8.Range("B2:B3001").Value
Sheet2.Range("BA5:BA3004") = Sheet8.Range("B2:B3001").Value
'Enhanced Push to Talk
Sheet2.Range("AA5:AA3004") = Sheet8.Range("C2:C3001").Value
Sheet2.Range("BC5:BC3004") = Sheet8.Range("C2:C3001").Value
'AT&T MDM
Sheet2.Range("AB5:AB3004") = Sheet8.Range("D2:D3001").Value
Sheet2.Range("BDZ5:BD3004") = Sheet8.Range("D2:D3001").Value
'Forms
Sheet2.Range("AC5:AC3004") = Sheet8.Range("E2:E3001").Value
Sheet2.Range("BE5:BE3004") = Sheet8.Range("E2:E3001").Value
'Toggle
Sheet2.Range("AD5:AD3004") = Sheet8.Range("F2:F3001").Value
Sheet2.Range("BF5:BF3004") = Sheet8.Range("F2:F3001").Value
'MRAS
Sheet2.Range("AE5:AE3004") = Sheet8.Range("G2:G3001").Value
Sheet2.Range("BG5:BG3004") = Sheet8.Range("G2:G3001").Value
'Comet
Sheet2.Range("AF5:AF3004") = Sheet8.Range("H2:H3001").Value
Sheet2.Range("BH5:BH3004") = Sheet8.Range("H2:H3001").Value
'Airwatch
Sheet2.Range("AI5:AI3004") = Sheet8.Range("J2:J3001").Value
Sheet2.Range("BK5:BK3004") = Sheet8.Range("J2:J3001").Value
'AprivaPay
Sheet2.Range("AG5:AG3004") = Sheet8.Range("I2:I3001").Value
Sheet2.Range("BI5:BI3004") = Sheet8.Range("I2:I3001").Value
'Big Tin Can
Sheet2.Range("AL5:AL3004") = Sheet8.Range("K2:K3001").Value
Sheet2.Range("BN5:BN3004") = Sheet8.Range("K2:K3001").Value
'Box
Sheet2.Range("AM5:AM3004") = Sheet8.Range("L2:L3001").Value
Sheet2.Range("BO5:BO3004") = Sheet8.Range("L2:L3001").Value
'OAH
Sheet2.Range("AN5:AN3004") = Sheet8.Range("M2:M3001").Value
Sheet2.Range("BP5:BP3004") = Sheet8.Range("M2:M3001").Value
'Office Direct
Sheet2.Range("AO5:AO3004") = Sheet8.Range("N2:N3001").Value
Sheet2.Range("BQ5:BQ3004") = Sheet8.Range("N2:N3001").Value
'Access My LAN
Sheet2.Range("Z5:Z3004") = Sheet8.Range("P2:P3001").Value
Sheet2.Range("BB5:BB3004") = Sheet8.Range("P2:P3001").Value
'Business Messaging
Sheet2.Range("AP5:AP3004") = Sheet8.Range("O2:O3001").Value
Sheet2.Range("BR5:BR3004") = Sheet8.Range("O2:O3001").Value
'Xora
Sheet2.Range("AK5:AK3004") = Sheet8.Range("Q2:Q3001").Value
Sheet2.Range("BM5:BM3004") = Sheet8.Range("Q2:Q3001").Value
'TeleNAV
Sheet2.Range("AJ5:AJ3004") = Sheet8.Range("R2:R3001").Value
Sheet2.Range("BL5:BL3004") = Sheet8.Range("R2:R3001").Value
'Unlimited Data
Sheet2.Range("X5:X3004") = Sheet8.Range("T2:T3001").Value
Sheet2.Range("AZ5:AZ3004") = Sheet8.Range("T2:T3001").Value
Application.ScreenUpdating = True
End Sub
Okay so I fixed that code.
 
Upvote 0
lightkerosene said:
You just opened my eyes. It is putting all of those as A2:A3001. But that wouldn't be the reason it isn't showing just the reason that it isnt copying the right stuff over, which I was going to look at tomorrow at work.
Click to expand...
I was wrong (I just tested it)... that single line of code does not work correctly (because there are non-contiguous ranges in it)... a small loop is necessary to handle each area in the non-contiguous range separately (but the code is still extremely quick). Sorry about that. Here is the correct code to replace the code that I quoted in my previous message)...
Code: 
[table="width: 500"]
[tr]
	[td]  Dim Ar As Range
  For Each Ar In Intersect(Sheet2.Rows("5:3004"), Sheet2.Range("X:AG,AJ:AP,AZ:BI,BK:BK,BN:BQ").EntireColumn).Areas
    Ar = Sheet8.Range("A2:A3001").Value
  Next[/td]
[/tr]
[/table]

Edit Note: I had also forgotten the Sheet2 references (code above fixed).
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Paste as Values using VBA
Replies
3
Views
368
Michael M
Michael M
J
  • Solved
Copy /past cells by inputbox on sheet 2 to sheet1 using VBA
2
Replies
12
Views
394
DanteAmor
DanteAmor
J
  • Solved
Copy Row x number of times from specific row and paste,shift down (VBA)
Replies
3
Views
313
MARK858
MARK858
C
  • Solved
VBA - Copy and paste a range of values N times
Replies
6
Views
306
cydmm
C
N
  • Question Question
VBA Questions - Copying dynamic data from one tab to another and deleting filtered rows
Replies
1
Views
453
DanteAmor
DanteAmor

Forum statistics

Threads
1,223,227
Messages
6,170,853
Members
452,361
Latest member
d3ad3y3

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