How to shorten code? Lots of Range select, Set, CopyPaste etc.

L

ljubo_gr

Board Regular
Joined
Dec 6, 2014
Messages
244
Office Version
  1. 2016
Platform
  1. Windows
Hi, dear MrExcel!
Are these examples possible:
Code: 
            Set ws3 = Sheets("blabalaal"): ws1 = Sheets("sghsghh"): ws2 = Sheets("gghksg") _
            : ws4 = Sheets("sjghjhgjd"): ws5 = Sheets("sghsjghj")

Code: 
                ws3.Range("B30:J51").Selection.Copy Destination:=ws2.Selection.PasteSpecial, Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
This one not working because comma at the end of PasteSpecial :(

Code: 
                ws3.Range("B2:J109").Selection.Copy

Is it error in that Selection? Should i remove that?
Thanks in advance kind people!


Orig.code:
Code: 
Sub Macro1_OCISTI_PODATKE_SA_IZVJESTAJA()
'
' Macro1_OCISTI_PODATKE_SA_IZVJESTAJA Macro
'
'
Dim MSG As String, ANS As Variant
MSG = "  SIGURNO  ŽELITE  OČISTITI  PODATKE ?"
ANS = MsgBox(MSG, vbExclamation + vbYesNo + vbDefaultButton2, "UPOZORENJE !!!")
Select Case ANS
Case vbYes
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
        On Error GoTo GRESKA2
            Set ws3 = Sheets("..........STANJE"): ws21 = Sheets("Izvještaj_BACKUP"): ws22 = Sheets("Izvještaj_SVE") _
            : ws24 = Sheets("Izvještaj_LETVE"): ws23 = Sheets("Visine_pomList")
            ws22.Range("B:B").Select
'Ovaj kod kopira izvješće na Izvještaj_SVE list.
            Dim R As Long
            If WorksheetFunction.CountA(Cells(2, 2).EntireColumn) > 18241 Then
                Rows("18242:18242").Range(Selection, Selection.End(xlDown)).Selection.Delete Shift:=xlUp
                Rows("2:48").Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Range("A2").Select
                ws3.Range("B30:J51").Selection.Copy Destination:=ws22.Selection.PasteSpecial, Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                Application.CutCopyMode = False
                Range("A24").Select
                ws3.Range("B53:J66").Selection.Copy Destination:=ws22.Selection.PasteSpecial, Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                Application.CutCopyMode = False
                Range("A38").Select
                ws3.Range("B12:J22").Selection.Copy Destination:=ws22.Selection.PasteSpecial, Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                Application.CutCopyMode = False
                Range("F2:I48").Selection.Cut Destination:=Range("E2:H48")
                Range("A2").Select
' Stupac B, tj. ako nije upisan vozač, onda je greška, pogrešno
' upisan samo datum, onda nije valjda bilo prodaje goriva.
                For R = Cells(Rows.Count, "B").End(xlUp).Row To 1 Step -1
                If Cells(R, "B") = "" Then Cells(R, "B").EntireRow.Delete xlUp
                Next R
            Sheets("Izvještaj_BACKUP").Select
        Else
                Rows("2:48").Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Range("A2").Select
                ws3.Range("B30:J51").Selection.Copy Destination:=ws22.Selection.PasteSpecial, Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                Application.CutCopyMode = False
                Range("A24").Select
                ws3.Range("B53:J66").Selection.Copy Destination:=ws22.Selection.PasteSpecial, Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                Application.CutCopyMode = False
                Range("A38").Select
                ws3.Range("B12:J22").Selection.Copy Destination:=ws22.Selection.PasteSpecial, Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                Application.CutCopyMode = False
                Range("F2:I48").Selection.Cut Destination:=Range("E2:H48")
                Range("A2").Select
' Stupac B, tj. ako nije upisan vozač, onda je greška, pogrešno
' upisan samo datum, onda nije valjda bilo prodaje goriva.
                For R = Cells(Rows.Count, "B").End(xlUp).Row To 1 Step -1
                If Cells(R, "B") = "" Then Cells(R, "B").EntireRow.Delete xlUp
                Next R
        End If
                
            ws21.Rows("4:4").Select
'Ovo kopira izvješće na list kao pričuva 14 izvještaja, računa CountA sve ćelije sa bilokakvim
'znakovima u četvrtom redu.
            Dim Sh As Shape
            If WorksheetFunction.CountA(Cells(4, 4).EntireRow) > 104 Then
                Columns("EB:EB").Range(Selection, Selection.End(xlToRight)).Selection.Delete Shift:=xlToLeft
                Columns("A:J").Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                ws3.Range("B2:J109").Selection.Copy
                ws21.Range("B2").Select ActiveSheet.Paste
                Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                    SkipBlanks:=False, Transpose:=False
                Range("H5:J8").Selection.Copy Selection.PasteSpecial, Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                For Each Sh In ActiveSheet.Shapes
                    Sh.Delete
                Next Sh
                Sheets(1).Activate ws3.Select
            Else
                Columns("A:J").Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                ws3.Range("B2:J109").Selection.Copy
                ws21.Range("B2").Select ActiveSheet.Paste
                Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                    SkipBlanks:=False, Transpose:=False
                Range("H5:J8").Selection.Copy Selection.PasteSpecial, Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                For Each Sh In ActiveSheet.Shapes
                    Sh.Delete
                Next Sh
                Sheets(1).Activate ws3.Select
            End If
' Ovaj dolje dio kopira letve na list Izvještaj_LETVE,
'   u slučaju greške ovo gore i ovo dolje neće ništa kopirati za backup! V A Ž N O!
                        ws24.Cells.Select
                        On Error GoTo nastavak
                        ActiveSheet.ShowAllData
nastavak:               Columns("B:B").Select
                    If WorksheetFunction.CountA(Cells(2, 2).EntireColumn) > 18241 Then
                        Rows("18242:18242").Range(Selection, Selection.End(xlDown)).Selection.Delete Shift:=xlUp
                        Rows("2:11").Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                        Range("A2").Select
                        ws3.Range("P7").Selection.Copy Destination:=ws24.Range("A2:A11").Selection.PasteSpecial, Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False
                        ws23.Range("K21:Q30").Selection.Copy Destination:=ws24.Range("B2").Selection.PasteSpecial, Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False
                        Application.CutCopyMode = False
                        ws23.Range("S21:S30").Selection.Copy Range("A1").Select
                        ws24.Range("I2").Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False
                        Range("A2:i11").Selection.Font.Bold = False
                        Range("A1").Select
                        Sheets(1).Activate
                        ws3.Select
                    Else
                        Rows("2:11").Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                        Range("A2").Select
                        ws3.Range("P7").Selection.Copy Destination:=ws24.Range("A2:A11").Selection.PasteSpecial, Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False
                        ws23.Range("K21:Q30").Selection.Copy Destination:=ws24.Range("B2").Selection.PasteSpecial, Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False
                        Application.CutCopyMode = False
                        ws23.Range("S21:S30").Selection.Copy Range("A1").Select
                        ws24.Range("I2").Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False
                        Range("A2:i11").Selection.Font.Bold = False
                        Range("A1").Select
                        Sheets(1).Activate
                        ws3.Select
                    End If
GRESKA2:
    'Ovo briše izvještaj sa kartice .......STANJE
        Range("G5:G8").Copy Destination:=Range("D5").PasteSpecial, Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("B12:F22,H12:J22,B24:F28,H24:J28,B30:F51,H30:J51,B53:F66,H53:J66,B70:F77,B79:F83,B85:F99,B101:F108").Select
        Selection.ClearContents
        Range("A1").Select
        Application.CutCopyMode = False
        
        Application.Calculation = xlCalculationAutomatic
        Application.EnableEvents = True
    
Case vbNo
GoTo QUIT:
         End Select
QUIT:
End Sub
 
Last edited:

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 don't need 'Selection' in any of them.

I'm guessing you learned by recording macros which is a great way of learning, though inefficient.

I also try not to do the pasting on the same line of code. It makes reading more easy and for me at least has eliminated a few headaches with code not working that seemed as though it should.

So If for example you wanted to copy Range A1:A3 on a sheet named Sheet1 and paste the values to Cell B1 on a 2nd sheet named Sheet2 I'd do something like:

Code: 
Sub CopyPasteExample()

Dim wsCopy As Worksheet, wsPaste As Worksheet
    
    'Set the Worksheet variables
    Set wsCopy = ThisWorkbook.Sheets("Sheet1")
    Set wsPaste = ThisWorkbook.Sheets("Sheet2")
    
    'Copy range A1:A3 on Sheet1
    wsCopy.Range("A1:A3").Copy
    
    'Paste to cell B1 on Sheet2
    wsPaste.Range("B1").PasteSpecial xlPasteAll
    
    'Tidy up
    Set wsCopy = Nothing
    Set wsPaste = Nothing
    
    
End Sub

Using a worksheet variable is preferable over using Sheets("Sheet1") as intellisense works with variables but not the sheets collection.

I didn't read all your code but saw you were getting bogged down with 'Selection' which is rarely needed.
 
Upvote 0
1) Why is that Tidy up part? I don't understand neither english nor VBA ;)
2) There will be a lot Dim, Dim this Dim that.....questionable efficiency.

Apparently, my Set part not working. I have error on GRESKA2 part:
 
Upvote 0
I can't view images sorry. But in short a line like this:
Code: 
[COLOR=#333333] ws23.Range("S21:S30").Selection.Copy Range("A1").Select[/COLOR]
would be better written:

Code: 
[COLOR=#333333] ws23.Range("S21:S30").Copy
[/COLOR][COLOR=#333333]Range("A1").PasteSpecial xlPasteAll[/COLOR]

Selection is not needed and is in fact used incorrectly in your code.
 
Upvote 0
An even better way of copying / pasting is one of:
Code: 
With ws23
    .Range("S21:S30").Copy .Range("A1")
End With

Code: 
ws23.Range("S21:S30").Copy ws.Range("A1")

Note that tidying up code or making it more efficient isn't necessarily about reducing the amount of code (although that's usually part of it) - it's about how quickly it will run and how easy it is to maintain / change / understand.
 
Upvote 0
The second code from my post, How to stick that together(copy-paste) in ONE line of code, brake by space&_? I have error in PasteSpecial, Paste.... this comma is problem!
 
Upvote 0
ljubo_gr said:
The second code from my post, How to stick that together(copy-paste) in ONE line of code, brake by space&_? I have error in PasteSpecial, Paste.... this comma is problem!
Click to expand...

Single line of code:
Code: 
ws3.Range("B30:J51").Copy: ws2.Range("A1").PasteSpecialxlPasteValues
 
Last edited:
Upvote 0
ws3.Range("G5:G8").Copy: ws3.Range("D5").PasteSpecialxlPasteValues
Click to expand...
This not working at all!
Code: 
            Set ws3 = Sheets("sgsgs"): Set ws21 = Sheets("hdhdhdh"): Set ws22 = Sheets("hdhsh") _
            : Set ws24 = Sheets("hshhrzgk"): Set ws23 = Sheets("kjjkre")
This also :( :(
 
Upvote 0
There was a space missing...
Code: 
ws3.Range("B30:J51").Copy: ws2.Range("A1").PasteSpecial xlPasteValues
 
Upvote 0
njimack said:
There was a space missing...
Code: 
ws3.Range("B30:J51").Copy: ws2.Range("A1").PasteSpecial xlPasteValues
Click to expand...

Thank you njimack, single space and now everything is working! At least beginning and ending of that big Orig,code:) Now ihave to cope with the rest of it:)


Ps. Is that .PasteSpecial xlPasteValues same as mine .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ?
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
Please help clean up my convoluted VBA code. It seems very redundant and repetitive.
Replies
1
Views
116
myall_blues
myall_blues
C
  • Solved
Please help me clean up my VBA script, I'm having trouble with redundancies
Replies
4
Views
132
CapRavOr
C
P
  • Solved
Counter in For Each loop
Replies
2
Views
250
Possum17
P
A
  • Question
Macro to update list to last row on another sheet copy source from multiple sheets
Replies
0
Views
334
Azamamir
A
P
  • Solved
Need help with macro Dynamic Range??
Replies
6
Views
237
pennbowl
P

Forum statistics

Threads
1,216,116
Messages
6,128,932
Members
449,480
Latest member
yesitisasport

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