Optimering af kode

Hej

Jeg er ny i vba og skal have nedenstående kode til at køre hurtigere. Jeg håber der er nogen som vil komme med input.

Option Explicit




Sub Sub_forrige_periode()




Application.ScreenUpdating = False

Dim Faggrupper As Variant 'Vektor med faggruppe
Dim Faggruppe As Variant 'Aktuelt ark

Dim sht As Worksheet
Dim LastRow As Long
Dim FirstRow As Integer


Dim n As Integer 'Første synlige række efter de skjulte rækker
Dim i As Integer 'Første kolonne med sagsdata

Dim startColumn As Integer
Dim endColumn As Integer

'Laver vektorer
Faggrupper = Array("Arkitekt", "Ingeniør" , "Konstruktør", "EogK", "VogA", "Byplan", "Bygherrerådgivning", "Byggeleder", "Brand", "El") 'Laver vektor med faggrupper


For Each Faggruppe In Faggrupper
Sheets(Faggruppe).Select

Set sht = ActiveSheet
n = 0
Do
    n = n + 1
Loop Until Cells(1, 7 + n).EntireColumn.Hidden = False 'Finder første skjulte kolonne efter række 6

'Viser første uge en uge tidligere
startColumn = n + 6

endColumn = n + 31

Range(Cells(, startColumn), Cells(, startColumn)).EntireColumn.Hidden = False


'Viser sidste uge en uge tidligere


Range(Cells(, endColumn + 1), Cells(, endColumn + 1)).EntireColumn.Hidden = True

LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

FirstRow = Range("A:A").Find(what:="PL", after:=Range("A1")).Row + 1

'Indsætter formel i kolonne F mellem række 25 og LastRow
For i = FirstRow To LastRow
    Cells(i, 6).FormulaR1C1 = "=SumVisible(RC[2]:RC[311])"
Next i

   
'Laver navne
'declare object variables to hold references to worksheet containing cell range, and cell range itself

    Dim myWorksheet As Worksheet
    Dim myNamedRange As Range
    'declare variable to hold defined name
    Dim myRangeName As String
   
   
    'identify worksheet containing cell range, and cell range itself
    Set myWorksheet = ThisWorkbook.Worksheets(Faggruppe)
   
    Set myNamedRange = myWorksheet.Range(Cells(4, startColumn), Cells(4, startColumn + 9))
    'specify defined name
    myRangeName = "Uger"
    'create named range with workbook scope. Defined name and cell range are as specified
    ThisWorkbook.Names.Add Name:=myRangeName, RefersTo:=myNamedRange

    Set myNamedRange = myWorksheet.Range(Cells(5, startColumn), Cells(5, startColumn + 9))
    'specify defined name
    myRangeName = "Kapacitet"
    'create named range with workbook scope. Defined name and cell range are as specified
    ThisWorkbook.Names.Add Name:=myRangeName, RefersTo:=myNamedRange
   
    Set myNamedRange = myWorksheet.Range(Cells(6, startColumn), Cells(6, startColumn + 9))
    'specify defined name
    myRangeName = "Fri"
    'create named range with workbook scope. Defined name and cell range are as specified
    ThisWorkbook.Names.Add Name:=myRangeName, RefersTo:=myNamedRange
   
    Set myNamedRange = myWorksheet.Range(Cells(7, startColumn), Cells(7, startColumn + 9))
    'specify defined name
    myRangeName = "NettoKapacitet"
    'create named range with workbook scope. Defined name and cell range are as specified
    ThisWorkbook.Names.Add Name:=myRangeName, RefersTo:=myNamedRange
   
    Set myNamedRange = myWorksheet.Range(Cells(8, startColumn), Cells(8, startColumn + 9))
    'specify defined name
    myRangeName = "ArbejdeIndvUge"
    'create named range with workbook scope. Defined name and cell range are as specified
    ThisWorkbook.Names.Add Name:=myRangeName, RefersTo:=myNamedRange
   
   
    Set myNamedRange = myWorksheet.Range(Cells(9, startColumn), Cells(9, startColumn + 9))
    'specify defined name
    myRangeName = "RestKapacitet"
    'create named range with workbook scope. Defined name and cell range are as specified
    ThisWorkbook.Names.Add Name:=myRangeName, RefersTo:=myNamedRange
   
Next Faggruppe
   
Application.ScreenUpdating = True

End Sub