flashing macro

fastbuck

Board Regular
Joined
Apr 22, 2014
Messages
144
Hi out there. I have this crazy macro that I use. There are ten of them that transfer info from one part of the sheet to another. When I active the macros there is a whole heap of flashing backwards and forwards as it does it’s transfer. Would there be a way of fixing it so it runs a bit smoother? Many thanks Narelle


Sub Result_R1()

ActiveSheet.Unprotect Password:=""


' Result_R1 Macro

Range("M6").Select

Selection.Copy

Range("AE2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("B28").Select

Application.CutCopyMode = False

Selection.Copy

Range("AF2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("A28").Select

Application.CutCopyMode = False

Selection.Copy

Range("AG2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("O1").Select

Application.CutCopyMode = False

Selection.Copy

Range("AH2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("E28").Select

Application.CutCopyMode = False

Selection.Copy

Range("AI2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("K3").Select

Application.CutCopyMode = False

Selection.Copy

Range("AJ2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("C28").Select

Application.CutCopyMode = False

Selection.Copy

Range("AK2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("F28").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ScrollColumn = 30

Range("AL2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("D28").Select

Application.CutCopyMode = False

Selection.Copy

Range("AM2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False



Range("G28").Select

Application.CutCopyMode = False

Selection.Copy

Range("AN2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

' Result_clear Macro

Range("A28:G28").Select

Range("F28").Activate

Selection.ClearContents

Range("E28").Select

ActiveSheet.Protect Password:=""

End Sub





 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Just a small thing. The cursor lands in E28 as it is supposed to but the page stays where the results end up. Is it possible for the page to end up back where cell E28 is? Thanks N
 
Upvote 0
Maybe this
Code:
Sub Result_R1()
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:=""
Range("M6").Copy
Range("AE2").PasteSpecial Paste:=xlPasteValues
Range("B28").Copy
Range("AF2").PasteSpecial Paste:=xlPasteValues
Range("A28").Copy
Range("AG2").PasteSpecial Paste:=xlPasteValues
Range("O1").Copy
Range("AH2").PasteSpecial Paste:=xlPasteValues
Range("E28").Copy
Range("AI2").PasteSpecial Paste:=xlPasteValues
Range("K3").Copy
Range("AJ2").PasteSpecial Paste:=xlPasteValues
Range("C28").Copy
Range("AK2").PasteSpecial Paste:=xlPasteValues
Range("F28").Copy
Range("AL2").PasteSpecial Paste:=xlPasteValues
Range("D28").Copy
Range("AM2").PasteSpecial Paste:=xlPasteValues
Range("G28").Copy
Range("AN2").PasteSpecial Paste:=xlPasteValues
Range("A28:G28").ClearContents
Range("E28").Select
ActiveSheet.Protect Password:=""
ActiveWindow.SmallScroll Down:=21
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Try this. Seems to do what you want.

Regards,
Howard


Code:
Option Explicit

Sub MyRevamp()

Dim myRng As Range
Dim rngC As Range
Dim i As Long
Dim myArr() As Variant
Range("E28").Activate

Set myRng = Range("M6, B28, A28, O1, E28, K3, C28, F28, D28, G28")
        
For Each rngC In myRng
    ReDim Preserve myArr(myRng.Cells.Count - 1)
    myArr(i) = rngC
    i = i + 1
Next

Sheets("Sheet1").Range("AE2").Resize(columnsize:=myRng.Cells.Count) = myArr

End Sub
 
Upvote 0
Hi Howard. Thanks for your reply. I must be doing something wrong. I cant get your code to work. Unfortunately, I'm not very savvy when it comes to making changes :( I'm trying to learn as I go along and it's great having this forum available.
The code from Michael M works okay.
 
Upvote 0
Hi fastbuck,

What does the code do or not do that makes it not work?

Do you get an error message, or is there a line of code that is yellow highlighted after running?

Howard
 
Upvote 0

Forum statistics

Threads
1,214,858
Messages
6,121,960
Members
449,057
Latest member
FreeCricketId

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