0

I'm trying to speed up this code so that it works for me in just 10-15sec. but I can't use the variables at all, can you help me?

The problem is that the code moves from one workbook to another workbook and it does everything very slowly

Can you help me remove SHEETS and RANGE with other variables?

Sub Obracun_place_NOVI_BK()

    Application.ScreenUpdating = False
    
    Sheets("PODUZEĆE_PLAĆA").Select
    Range("B7:H129").ClearContents

    Sheets("Neto plaća").Select
    
    If Range("C10") <> 0 Then
    BK_RAZRADA
    End If
    Sheets("2001").Select
    Exit Sub
    
End Sub
Sub BK_RAZRADA()

ActiveSheet.Range("$CJ$11:$CO$4112").AutoFilter Field:=1, Criteria1:=Range("A2")
    ActiveSheet.Range("$CJ$11:$CO$4112").AutoFilter Field:=4, Criteria1:="<>"
    Range("CI11:CO11").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("PODUZEĆE_PLAĆA").Select
    Range("B6").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
   
        xlNone, SkipBlanks:=False, Transpose:=False
    
    

    ActiveWorkbook.Worksheets("PODUZEĆE_PLAĆA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("PODUZEĆE_PLAĆA").Sort.SortFields.Add Key:=Range( _
        "C7:C127"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("PODUZEĆE_PLAĆA").Sort
        .SetRange Range("B6:H129")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Placa_Spisak_Filter


    Osvjezi_preb
    OSVJEZI_BROJ_OPCINA
    
'Lista_doprinosa
Sheets("2001").Select
Application.ScreenUpdating = True
'Save_Lista_AsPDF
End Sub

I got this code below

Sub Obracun_place_NOVI_FILIP()

    Application.ScreenUpdating = False
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the source worksheet ('sws').
    Dim sws As Worksheet: Set sws = wb.Worksheets("Neto plaća")
    Dim stbl As Range
    Set stbl = sws.Range("$CJ$11:$CO$4112")
    
    ' Reference the destination worksheet ('dws').
    Dim dws As Worksheet: Set dws = wb.Worksheets("PODUZEĆE_PLAĆA")
    
    ' Clear the (old) destination data range (headers are in row 6).
    With dws.Range("B7:H7")
        .Range(.Cells, .End(xlDown)).ClearContents
    End With
    
    
   'Filter the source table.'
    With stbl
        'Clear possible existing filters.
       If .ShowAutoFilter Then
         If .AutoFilter.FilterMode Then .AutoFilter.ShowAllData
        Else
            .ShowAutoFilter = True
        End If
         'Filter.
        .Range.AutoFilter Field:=1, Criteria1:=(sws.Range("A2").Value)
        .Range.AutoFilter Field:=4, Criteria1:="<>"
     End With
braX
  • 11,506
  • 5
  • 20
  • 33

0 Answers0