• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copy/Paste non contiguous range data simple and fast

L

l_mirica

New Member
Hello everybody,


Recently at work we have been "upgraded" from XP to Win7 and from MS Office 2003 to MS Office 2010 but, as normal, not all users; this is made gradually since we are many.


Myself, I am working with an Excel file daily so I hit a bump:

there is a file that stores all that I work using a macro but it can not work on all files (something is changed due to the file being modified with 2003 version and then passed to 2010) so I have made myself another code that takes what I need from the file and puts it into a new & fresh file.


My need for your assistance is whether it can be simplified (thus me gaining some precious seconds - a lot of files per day = quite some time spared /or lost).


Here is my code:

"Sub TEST()

'

' TEST Macro

'


'open new file

Workbooks.Open Filename:= _"http:file_location"


'go to required sheet (my case "Form")

Sheets("Formulaire - Form").Select

'actual code to be shrinked

Rows("59:71").Select

Selection.EntireRow.Hidden = False

ActiveWindow.SmallScroll Down:=-72

Range("E9:G9").Select

ActiveWindow.ActivateNext

Range("E9:G9").Select

Selection.Copy

ActiveWindow.ActivatePrevious

Range("E9:G9").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

Range("E11:G11").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("E11:G11").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

Range("E13:G13").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("E13:G13").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

Range("E15:G15").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("E15:G15").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

Range("E17:G17").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("E17:G17").Select

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

:=False, Transpose:=False

ActiveWindow.SmallScroll Down:=12

ActiveWindow.ActivateNext

ActiveWindow.SmallScroll Down:=12

Range("E19:G19").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("E19:G19").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

Range("E21:G21").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("E21:G21").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

ActiveWindow.SmallScroll Down:=12
/>Range("E28:G28").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

ActiveWindow.SmallScroll Down:=6

Range("E28:G28").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

Range("E30:G30").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("E30:G30").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

Range("E32:G32").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("E32:G32").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

Range("E34:G34").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("E34:G34").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

Range("E36:G36").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("E36:G36").Select

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

:=False, Transpose:=False

ActiveWindow.SmallScroll Down:=12

ActiveWindow.ActivateNext

Range("E38:G38").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.SmallScroll Down:=9

ActiveWindow.ActivatePrevious

Range("E38:G38").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

ActiveWindow.SmallScroll Down:=9

Range("E48:G48").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("E48:G48").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

Range("E50:G50").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

ActiveWindow.SmallScroll Down:=9

Range("E50:G50").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

Range("E52:G52").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("E52:G52").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

Range("E54:G54").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("E54:G54").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

ActiveWindow.SmallScroll Down:=9

Range("E63").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

ActiveWindow.SmallScroll Down:=6

Range("E63").Select

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

:=False, Transpose:=False

ActiveWindow.ActivatePrevious

ActiveWindow.ActivateNext

ActiveWindow.ActivateNext

Range("G63").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("G63").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

Range("C65").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("C65").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

Range("D65").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("D65").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

Range("E65").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("E65").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

Range("F65").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("F65").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

Range("G65").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("G65").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

Range("E67:K67").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("E67:K67").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

Range("A72:F95").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.SmallScroll Down:=15

ActiveWindow.ActivatePrevious

ActiveWindow.SmallScroll Down:=15

Range("A72:F95").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

Range("G72:p95").Select

Application.CutCopyMode = False

Selection.Cut

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("G72:p95").Select

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

:=False, Transpose:=False

ActiveWindow.SmallScroll Down:=15

ActiveWindow.ActivateNext

ActiveWindow.SmallScroll Down:=18

Range("E97:F97").Select

Application.CutCopyMode = False

Selection.Copy

ActiveWindow.ActivatePrevious

Range("E97:F97").Select

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

:=False, Transpose:=False

ActiveWindow.ActivateNext

ActiveWindow.Close

End Sub"

Thank you in advance for your help !
 
Hello ! To gain time, avoid Select !


For example your code

[pre]
Code: 
Rows("59:71").Select
Selection.EntireRow.Hidden = False[/pre]
can be reduced in a single line :

[code]Rows("59:71").EntireRow.Hidden = False


Start your sub with

Application.ScreenUpdating = False[/code]

will accelerate your process and back it to True in the end of Sub …
 
wow !!!! this is pure gold !!! I will give the rest of the solution a go (not sure if I'll pull it out) but the background work it does and not showing on the screen is already making a huge time difference, not to mention the eye care !
 
I was a little bored, so took a crack at simplifying this. Took out all the Scrolling (purely a human visual, XL doesn't need to do it) and the turning off of CopyMode (can just do it once at end). Then, I took the part that keeps repeating an moved it to a separate macro. I think this is easier to read as well.

[pre]
Code: 
Sub TEST()
'
' TEST Macro
'
Application.ScreenUpdating = False
'open new file
Workbooks.Open Filename:= _
"http:file_location"

'go to required sheet (my case "Form")
Sheets("Formulaire - Form").Select

'actual code to be shrinked
Rows("59:71").EntireRow.Hidden = False

'Rather than repeating everything, use a separate macro
'If there's something special about all these ranges, but be able to reduce even further
RepeatingCode ("E9:G9")
RepeatingCode ("E11:G11")
RepeatingCode ("E13:G13")
RepeatingCode ("E15:G15")
RepeatingCode ("E17:G17")
RepeatingCode ("E19:G19")
RepeatingCode ("E21:G21")
RepeatingCode ("E28:G28")
RepeatingCode ("E30:G30")
RepeatingCode ("E32:G32")
RepeatingCode ("E34:G34")
RepeatingCode ("E36:G36")
RepeatingCode ("E38:G38")
RepeatingCode ("E48:G48")
RepeatingCode ("E50:G50")
RepeatingCode ("E52:G52")
RepeatingCode ("E54:G54")
RepeatingCode ("E63")
RepeatingCode ("G63")
RepeatingCode ("C65")
RepeatingCode ("D65")
RepeatingCode ("E65")
RepeatingCode ("F65")
RepeatingCode ("G65")
RepeatingCode ("E67:K67")
RepeatingCode ("A72:F95")
RepeatingCode ("G72:P95")
RepeatingCode("E97:F97")

Application.CutCopyMode = False
ActiveWindow.Close
Application.ScreenUpdating = True
End Sub

Sub RepeatingCode(myRange As String)
Range(myRange).Copy
ActiveWindow.ActivatePrevious
Range(myRange).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.ActivateNext
End Sub
[/pre]
 
You must log in or register to reply here.
Back
Top