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

L

ljubo_gr

Active Member
Joined
Dec 6, 2014
Messages
251
Office Version
  1. 2013
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:
Sort by date Sort by votes
I really don't know VBA :(
This version of Set also not working, it sets only ws3 and ws21 :(
Code: 
            Set ws3 = Sheets("dfghehb")
            Set ws21 = Sheets("ghhčdhdl")
            Set ws22 = Sheets("blablablab")
            Set ws24 = Sheets("yaydyaydyad")
            Set ws23 = Sheets("clinfjgkgcgbl")
 
Upvote 0

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
You must log in or register to reply here.

Similar threads

D
  • Solved
Insert formula in last column macro
2
Replies
13
Views
215
MARK858
MARK858
willow1985
  • Solved
VBA Run-time error 91 - Object variable or With block variable not set when trying to refresh data/Sleep
Replies
4
Views
400
willow1985
willow1985
K
  • Question Question
Increasing row before the macro runs again
Replies
1
Views
230
kbk
K
Dazzawm
  • Solved
Change Range To Recorded Macro
Replies
3
Views
191
Alex Blakenburg
A
R
  • Question Question
I keep getting the error 91 but i cant figure out what is wrong here.
Replies
2
Views
60
mumps
mumps

Forum statistics

Threads
1,224,827
Messages
6,181,198
Members
453,022
Latest member
RobertV1609

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