Run-Time error 1004

Hej
Jeg har en projektmappe hvorfra jeg åbner en anden projektmappe. En gang i mellem (kun for enkelte projektmapper får jeg følgende fejlmeddelelse: Run-time error '1004' Metoden select for klassen range mislykkedes

Jeg anvender følgende funktion og åbner mappen vha nederste sub:

Function WorkbookOpen(WorkBookName As String) As Boolean
' returns TRUE if the workbook is open
    WorkbookOpen = False
    On Error GoTo WorkBookNotOpen
    If Len(Application.Workbooks(WorkBookName).Name) > 0 Then
        WorkbookOpen = True
        Exit Function
    End If
WorkBookNotOpen:
End Function

Jeg åbner herefter mappen udfra:



Application.ScreenUpdating = False
If Sheets("Ark1").Range("Q57") <> "" Then
Sheets("Ark1").Select
 
Dim Navn As String, HCV As String, Cpr As String, sPath As String, WB As Workbook
Dim Adr As String, PostBy As String, Kommune As String, Tlf As String, El As String, ElAdr As String, ElPostBy As String
Dim Stamsygehus As String
    sPath = "\\server\faelles\Index data\patientmapper\"
   
    With ActiveWorkbook.Sheets("Ark1")
    Cpr = ActiveCell.Offset(0, -2).Value
    Navn = ActiveCell.Offset(0, -4).Value
    HCV = ActiveCell.Value
    Adr = ActiveCell.Offset(0, 18).Value
    PostBy = ActiveCell.Offset(0, 20).Value
    Kommune = ActiveCell.Offset(0, 40).Value
    Tlf = ActiveCell.Offset(0, 22).Value
    El = ActiveCell.Offset(0, 24).Value
    ElAdr = ActiveCell.Offset(0, 26).Value
    ElPostBy = ActiveCell.Offset(0, 28).Value
    Stamsygehus = ActiveCell.Offset(0, 72).Value
    End With
   
    'If Dir(sPath & Cpr & ".opr") <> "" Then
    'Workbooks.Open sPath & Cpr & ".opr"

If Cpr <> "" Then

    Dim owb As String
    owb = Cpr & ".opr"
   
    If Dir(sPath & owb) <> "" Then
               
        If Not WorkbookOpen(owb) Then
        ChDir sPath
        Workbooks.Open (owb)
        ActiveWindow.Zoom = 105
        Else
        Workbooks(owb).Activate
        Sheets("Stamkort").Activate
        ActiveWindow.Zoom = 105
        End If

    Else:
   
    Dim Msg, Style, Title, Ctxt, Response, MyString
    Msg = "Skal der oprettes en ny patientmappe?"    ' Define message.
    Style = vbYesNo + vbDefaultButton2    ' Define buttons.
    Title = "Meddelelsesbox"    ' Define title.
    Response = MsgBox(Msg, Style, Title)
    If Response = vbYes Then

    Workbooks.Open ("\\server\faelles\Index\dokumenter\Patientskabelon\Patient.xls")
   
    Set WB = ActiveWorkbook
   
        With WB.Worksheets("Stamkort")
            .Range("D6").Value = Navn
            .Range("D7").Value = Cpr
            .Range("M6").Value = HCV
            .Range("D8").Value = Adr
            .Range("D9").Value = PostBy
            .Range("D10").Value = Kommune
            .Range("D11").Value = Tlf
            .Range("S6").Value = El
            .Range("S7").Value = ElAdr
            .Range("S8").Value = ElPostBy
            .Range("S11").Value = Stamsygehus
        End With
       
    ActiveWorkbook.SaveAs Filename:=sPath & Cpr & ".opr"
   
    End If
 
    End If

Else:
MsgBox "Feltet med cpr-nr må ikke være tomt"
End If

Else
FrmAdgang.Show
End If

vh Steen