Új hozzászólás Aktív témák

• #48987 Mutt senior tag andreas49 #48984

  Új Válasz 2022-05-08 20:00:33 #48987

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Mutt

  senior tag

  válasz andreas49 #48984 üzenetére

  Szia,

  Ezt próbáld meg. A kommentek alapján tudod módosítani.

  Sub vissza()
Dim wsTOC As Worksheet
Dim ws As Worksheet
Dim i As Long, c As Long
Dim result As Range
Dim back As Range

'a munkalap neve, ahíol megtalálhatók a lapok nevei, ezt javítsd a megfelelőre
Const TOC = "Start"

Set wsTOC = Worksheets(TOC)

'végig futunk a munkalapokon
For i = 1 To Worksheets.Count
Set ws = Worksheets(i)

'csak más nevű munkalapok érdekelnek
If ws.Name <> TOC Then
'keressük meg helyét a munkalapnak az összesítőn
Set result = wsTOC.Range("A:A").Find(ws.Name)

'ha nincs meg akkor ugorjuk át
If Not result Is Nothing Then
Set back = ws.Range("A2")

'ha üres lenne a cella akkor írjuk bele ezt, ha nem kell akkor töröld ki
If back = "" Then back = "vissza"

'ha már lenne hivatkozás, akkor töröljük a korábbit
If back.Hyperlinks.Count > 0 Then back.Hyperlinks.Delete

'adjuk hozzá a linket
back.Hyperlinks.Add Anchor:=back, Address:="", SubAddress:="'" & TOC & "'!" & result.Address
End If
End If
Next i

'nem kötelező de szüntessük meg az objektumokat
Set back = Nothing
Set result = Nothing
Set ws = Nothing
Set wsTOC = Nothing
End Sub

  üdv

• #48985 Delila_1 veterán andreas49 #48984

  Új Válasz 2022-05-07 12:09:08 #48985

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz andreas49 #48984 üzenetére

  Tegyél az első lapra egy gombot (én lekerekített téglalapot tettem).
  A makrót a ThisWorkbook-ba másold be.

  Sub Vissza()
    Dim lapnev
    lapnev = ActiveSheet.Name * 1
    Sheets("Tartalom").Select
    Cells(Application.Match(lapnev, Columns(1), 0), 1).Select
End Sub

Új hozzászólás Aktív témák