Sub worksheetLinks()
 
Dim wrbBok As Workbook
Dim wrsAktivtArk As Worksheet, wsArk As Worksheet
Dim intRad As Integer, intKolumn As Integer
 
Set wrbBok = ActiveWorkbook
Set wrsAktivtArk = ActiveSheet
 
intRad = 2
intKolumn = 1
 
For Each wsArk In wrbBok.Worksheets
 
If wsArk.Name <> "Kasacja" Then
    If wsArk.Name <> wrsAktivtArk.Name Then
        wrsAktivtArk.Hyperlinks.Add wrsAktivtArk.Cells(intRad, _
        intKolumn), "", SubAddress:="'" & wsArk.Name & "'!A1", TextToDisplay:=wsArk.Name
        wrsAktivtArk.Cells(intRad, "B") = wsArk.Range("D1")
        wrsAktivtArk.Cells(intRad, "C") = wsArk.Range("K15")
            intRad = intRad + 1
    End If
End If
 Next wsArk
 
End Sub

Sub worksheetLinks()
 
Dim wrbBok As Workbook
Dim wrsAktivtArk As Worksheet, wsArk As Worksheet
Dim intRad, intKolumn As Integer
 
Set wrbBok = ActiveWorkbook
Set wrsAktivtArk = ActiveSheet
 

intRad = 2
intKolumn = 1
 

For Each wsArk In wrbBok.Worksheets
 
If wsArk.Name = "Kasacja" Then GoTo nastepnyArk

If wsArk.Name <> wrsAktivtArk.Name Then
 
wrsAktivtArk.Hyperlinks.Add wrsAktivtArk.Cells(intRad, _
intKolumn), "", SubAddress:="'" & wsArk.Name & "'!A1", TextToDisplay:=wsArk.Name
 
intRad = intRad + 1
End If
 
nastepnyArk:
Next wsArk
 
End Sub