VBA shortcut

[Googles]

Hello, i have programmed this code but I find it very large!!
Can someone shorten this code for me please!!?

For i = 1 To 19    Select Case i
        Case 1: CopyRngF = "E11:J": CopyRngT = "E11"
        Case 2: CopyRngF = "M11:AQ": CopyRngT = "M11"
        Case 3: CopyRngF = "BD11:CE": CopyRngT = "BD11"
        Case 4: CopyRngF = "CS11:DW": CopyRngT = "CS11"
        Case 5: CopyRngF = "EJ11:FM": CopyRngT = "EJ11"
        Case 6: CopyRngF = "FZ11:HD": CopyRngT = "FZ11"
        Case 7: CopyRngF = "HQ11:IT": CopyRngT = "HQ11"
        Case 8: CopyRngF = "JG11:KK": CopyRngT = "JG11"
        Case 9: CopyRngF = "KX11:MB": CopyRngT = "KX11"
        Case 10: CopyRngF = "MO11:NR": CopyRngT = "MO11"
        Case 11: CopyRngF = "OE11:PI": CopyRngT = "OE11"
        Case 12: CopyRngF = "PV11:QY": CopyRngT = "PV11"
        Case 13: CopyRngF = "RL11:SP": CopyRngT = "RL11"
        Case 14: CopyRngF = "TA11:TA": CopyRngT = "TA11"
        Case 15: CopyRngF = "TL11:TM": CopyRngT = "TM11"
        Case 16: CopyRngF = "TP11:TW": CopyRngT = "TQ11"
        Case 17: CopyRngF = "UA11:UB": CopyRngT = "UB11"
        Case 18: CopyRngF = "UD11:UP": CopyRngT = "UE11"
        Case 19: CopyRngF = "UR11:UR": CopyRngT = "US11"
    End Select
    wsCopyFrom.Range(CopyRngF & 38).Copy
    wsCopyTo.Range(CopyRngT).PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next i

thanks

 

[Joe4]

I don't think that is large at all.
Unless there is some sort of consistent pattern in the number of columns you are jumping, it is going to be hard to automate it much more than you have.
The only other thing I can think of is to copy your column references to an array or two, and loop through those.
I don't think it will make the code much faster, maybe just a little smaller.

 

[Jan Mach]

It IS too large. The NORMAL way of programming is to use NAMED ranges! Name the ranges E11:J38, M11:AQ38, ..., , UR11:UR38 in wsCopyFrom with names rng0, rng1, ..., rng18, and the cells E11, M11, ..., , US11 in wsCopyTo with names cll0, cll1, ..., cll18, and write:

Dim i[COLOR=#222222][FONT=arial]&
[/FONT][/COLOR]For i = 0 To 18
    Range("rng" [COLOR=#222222][FONT=arial]&[/FONT][/COLOR] i).Copy
    Range("cll"[COLOR=#222222][FONT=arial]&[/FONT][/COLOR][COLOR=#333333][FONT=arial] i).[/FONT][/COLOR][COLOR=#333333][FONT=arial][COLOR=#333333][FONT=arial]PasteSpecial xlPasteValues, xlNone, False, False
[/FONT][/COLOR][/FONT][/COLOR][LEFT][COLOR=#333333][FONT=arial][LEFT][COLOR=#333333][FONT=arial]Next[/FONT][/COLOR][/LEFT]
[/FONT][/COLOR][/LEFT]

​

 

[Fluff]

Jan Mach
If you are going to shout at people, it would be nice if you could get your details correct first.
rng1 through to rng18 are not valid names for a named range, the same is true for cll1 to cll18

 

[Joe4]

It IS too large. The NORMAL way of programming is to use NAMED ranges!

Shorter does not always mean better. Much of that depends on the users needs and how the sheet will be used.

I have seen a lot of issues people have with named ranges, especially if they may be inserting and deleting rows/columns on their sheets. Those named ranges can get messed up in quite a hurry and cause a bunch of reference errors.
Also, if that last row number may not be static, naming ranges ahead of time probably won't work for them, and they will require a more dynamic solution.

Even if they are to use named ranges, while the code may be a little shorter, it probably won't save them much time, as they need to manually go through and name each range ahead of time.

 

[Macropod]

Potentially simpler, depending on how well matched your to & from starting addresses are for subsequent cases:

Dim strAddr As String
For i = 1 To 19
    Select Case i
        Case 1: strAddr = "E11:J":
        Case 2: strAddr = "M11:AQ"
        Case 3: strAddr = "BD11:CE"
        Case 4: strAddr = "CS11:DW"
        Case 5: strAddr = "EJ11:FM"
        Case 6: strAddr = "FZ11:HD"
        Case 7: strAddr = "HQ11:IT"
        Case 8: strAddr = "JG11:KK"
        Case 9: strAddr = "KX11:MB"
        Case 10: strAddr = "MO11:NR"
        Case 11: strAddr = "OE11:PI"
        Case 12: strAddr = "PV11:QY"
        Case 13: strAddr = "RL11:SP"
        Case 14: strAddr = "TA11:TA"
        Case 15: strAddr = "TL11:TM"
        Case 16: strAddr = "TP11:TW"
        Case 17: strAddr = "UA11:UB"
        Case 18: strAddr = "UD11:UP"
        Case 19: strAddr = "UR11:UR"
    End Select
    wsCopyFrom.Range(strAddr & 38).Copy
    wsCopyTo.Range(Split(strAddr, ":")(0)).Offset(0, Int(i / 15)).PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next i