Optimering af makro #1

Jeg har gennem længere tid sammenstykket nedenstående makro ved hjælp af mange brugere på eksperten.dk.

Min udfordring ligger i at den godt nok er færdig, men virker noget uoverskuelig. Derfor vil jeg gerne have hjælp til at optimere makroen.

Der er en lille ekstra makro - den (Private Function test_server(StiOgFil) As Boolean) er blot med for forståelsens skyld.
Makroen OpdateringAfVersion skal optimeres senere :-)

Husk makroen skal gøre det samme som nedenstående!

På forhånd tak!

Sub KopiAfSkattesatser()
  'Kontrol om der er skriveadgang ned i Skattesatser
  'Kopier og indsætter data fra filen Skattesatser til Stamdata
  'og laver MsgBox der fortæller at data er opdateret
 
  Dim x As Boolean
  Dim stStiOgFil As String
  Dim BeskedAdgang As String
  Dim BeskedIngenAdgang As String
  Dim objOpenWB As Workbook
  Dim objWB As Workbook
  Dim strFilename As String
  Dim objOpen As Integer
 
  'Dette er mappen hvor Stamdata.xls ligger
  Const FilMappe As String = "C:\Test\Skat\"
 
'Sti til filen - Filen skal være TEST.xls
  stStiOgFil = FilMappe & "test.xls"
 
x = test_server(stStiOgFil)
If x = True Then

    Application.ScreenUpdating = False
   
    'Skriver sti-, fil- og arknavn
    Sheets("Beregninger").Range("C25") = ActiveWorkbook.FullName
    Sheets("Beregninger").Range("C26") = ActiveWorkbook.Name
    Sheets("Beregninger").Range("C29") = ActiveSheet.Name

    'Kopi af stinavn fra C25 og C26 og version fra C27 og Årstal fra C28 og Aktivt ark fra C29
    Sheets("Beregninger").Range("C25:C29").Copy
   
    'Sætter filsti for Stamdata
    strFilename = FilMappe & "Stamdata.xls"

    'Løber alle åbne Excel-filer igennem for at tjekke Stamdata.xls findes.
    'Hvis den er åben, sættes en reference til den.
        For Each objOpenWB In Application.Workbooks
            If objOpenWB.FullName = strFilename Then
                Set objWB = objOpenWB
                objOpen = 1
                Exit For
            End If
        Next

        'Hvis Stamdata.xls ikke er åben åbnes den.
        If objWB Is Nothing Then
            Set objWB = Workbooks.Open(Filename:=strFilename, ReadOnly:=True)
           
        End If

    'Indsætter Stinavn og Filnavn ind i arket Beregninger i C25 og C26 og version fra C27 og Årstal fra C28
    ' og Aktivt ark fra C29
    objWB.Sheets("Beregninger").Range("C25:C29").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'Køre makro i Stamdata
    Application.Run ("Stamdata.xls!OpdateringAfVersion")
       
        'Hvis Stamdata.xls er åben (objOpen =1), lukkes den ikke
        If objOpen = 1 Then
       
        Else
        'Lukker Stamdata.xls
        Workbooks("Stamdata.xls").Close savechanges:=False
        End If
       
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
Else
 
    'Besked hvis der ikke er skriverettigheder ned på server
    sLangTekst = "Du har ikke skrive-adgang til G-drevet, så du kan ikke opdaterer data!" & vbNewLine
    sLangTekst = sLangTekst & "" & vbNewLine
    sLangTekst = sLangTekst & "Tilslut dig netværket og prøv igen!"
    BeskedIngenAdgang = MsgBox(sLangTekst, vbOKOnly + vbCritical, "Ingen adgang til serveren")
 
End If
End Sub
 
Private Function test_server(StiOgFil) As Boolean
'Kontrol af skriveadgang til drev
'Bruges af KopiAfSkattesatser

  On Error GoTo IngenAdgang
  Open StiOgFil For Output As #1
  Write #1, "Testing"
  Close #1
  test_server = True
  Kill StiOgFil
  Exit Function
IngenAdgang:
  test_server = False
End Function