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:
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

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
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
236
pennbowl
P

Forum statistics

Threads
1,216,113
Messages
6,128,903
Members
449,477
Latest member
panjongshing

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