VBA Macro created hyperlink problem

I have a macro which creates folders, saves current workbook into created folders and anchors hyoerlinks to those folders into specific cells.
when i run the macro for the first saving, it runs perfectly. When i run the macro for the second saving, it again works. However after creating second one when i click on the first hyperlink it does not work.

i realized that adress of the first hyperlink changes when i create second hyperlink. what can be the reason for this? any ideas?

ew03,

Could you share the code?

[]'s

I ran into some VBA hyperlink related problems the other day. I found out that deleting hyperlink (or the entire cell content, I don't remember which) before and adding a new worked better than trying to change address and stuff. I can look it up tomorrow if no one else solves it until then.

Jacc
I am not trying to change the existing cell, i am creating a new hyperlink in a different cell. This is some kind of archieve i am trying to create

here is my code

Sub arsiv()
Dim i As Integer, arsiv As String, k As Integer, n As Integer, s As String, c As Integer, ThisBook As Workbook, WkSht As Worksheet, m As String, p As String, r As String, b As Boolean

m = Sheets("VERİ GİRİŞİ").Range("a1000") & "\"
p = Format(Date, "mm-dd-yyyy") & " - " & Sheets("VERİ GİRİŞİ").Range("B5").Value & "\"
r = Sheets("VERİ GİRİŞİ").Range("B5").Value & "-" & Format(Date, "mm-dd-yyyy")
b = False
c = 0

Do Until b = True

p = Format(Date, "mm-dd-yyyy") & " - " & Sheets("VERİ GİRİŞİ").Range("B5").Value & " rev" & c & "\"
If Len(Dir(m & p, vbDirectory)) = 0 Then
    MkDir m & p
    s = m & p
    Set ThisBook = ThisWorkbook
        Application.ScreenUpdating = False
        ThisWorkbook.SaveCopyAs (s & r & ".xls")
        Application.Workbooks.Open s & r & ".xls"
        For Each WkSht In ActiveWorkbook.Worksheets
            Select Case WkSht.Name
            Case "VERİ GİRİŞİ", "ARŞİV", "FİRMALAR"
                Application.DisplayAlerts = False
                WkSht.Delete
            Case Else
            End Select
            Application.CutCopyMode = False
        Next WkSht
        ActiveWorkbook.Save
        ActiveWorkbook.Close
    n = Sheets("VERİ GİRİŞİ").Range("B6").Value
    k = 2
    For k = 2 To 10000
        If Sheets("ARŞİV").Cells(k, 1).Value = "" Then
        Sheets("ARŞİV").Cells(k, 1).Value = k - 1
        Sheets("ARŞİV").Cells(k, 2).Value = Sheets("VERİ GİRİŞİ").Cells(5, 2).Value
        Sheets("ARŞİV").Cells(k, 3).Value = Sheets("VERİ GİRİŞİ").Cells(6, 2).Value
        Sheets("ARŞİV").Cells(k, 4).Value = Sheets("VERİ GİRİŞİ").Cells(9, 2).Value
        Sheets("ARŞİV").Cells(k, 5).Value = Sheets("VERİ GİRİŞİ").Cells(12, 2).Value
        For i = 3 To n + 1
        Sheets("ARŞİV").Cells(k, 4).Value = Sheets("ARŞİV").Cells(k, 4).Value & Chr$(13) & Chr$(10) & Sheets("VERİ GİRİŞİ").Cells(9, i).Value
        Sheets("ARŞİV").Cells(k, 5).Value = Sheets("ARŞİV").Cells(k, 5).Value & Chr$(13) & Chr$(10) & Sheets("VERİ GİRİŞİ").Cells(12, i).Value
        Next i
        Sheets("ARŞİV").Cells(k, 6).Value = Sheets("VERİ GİRİŞİ").Cells(4, 2).Value
        Sheets("ARŞİV").Cells(k, 7).Value = Format(Date, "mm-dd-yyyy")
        Sheets("ARŞİV").Activate
        Sheets("ARŞİV").Cells(k, 8).Select
        Sheets("ARŞİV").Cells(k, 8).Hyperlinks.Add Anchor:=Selection, Address:=s, TextToDisplay:= _
            "link" & k - 1
        Sheets("VERİ GİRİŞİ").Activate
        Exit For
        End If
    Next k

    Sheets("ARŞİV").Range(Sheets("ARŞİV").Cells(2, 1), Sheets("ARŞİV").Cells(k, 8)).Borders(xlInsideVertical).LineStyle = XlLineStyle.xlContinuous
    Sheets("ARŞİV").Range(Sheets("ARŞİV").Cells(2, 1), Sheets("ARŞİV").Cells(k, 8)).Borders(xlInsideHorizontal).LineStyle = XlLineStyle.xlContinuous
    Sheets("ARŞİV").Range(Sheets("ARŞİV").Cells(2, 1), Sheets("ARŞİV").Cells(k, 8)).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
    Sheets("ARŞİV").Range(Sheets("ARŞİV").Cells(2, 1), Sheets("ARŞİV").Cells(k, 8)).Borders(xlEdgeTop).LineStyle = XlLineStyle.xlContinuous
    Sheets("ARŞİV").Range(Sheets("ARŞİV").Cells(2, 1), Sheets("ARŞİV").Cells(k, 8)).Borders(xlEdgeLeft).LineStyle = XlLineStyle.xlContinuous
    Sheets("ARŞİV").Range(Sheets("ARŞİV").Cells(2, 1), Sheets("ARŞİV").Cells(k, 8)).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
    b = True
End If
c = c + 1
Loop

MsgBox "COC taramasını seçiniz", vbInformation, Title:="ARŞİVLEME"
    With Application.FileDialog(msoFileDialogFilePicker)
    
        .InitialFileName = "C:\"
        .Show
        If .SelectedItems.Count > 0 Then
            arsiv = .SelectedItems(1)
        Else
            MsgBox "Dosya seçimi iptal edildi", vbInformation, Title:="İşlem iptal edildi"
            Exit Sub
        End If
    End With


FileCopy arsiv, m & p & "coc.docx"

End Sub