Solved: Some sheets no hyperlinks.

[Pinokkio]

This macro sheets, the "Invoice", "Customers", "Debtor" and "Articles" may not have hyperlinks to return to sheet "Inhoudsopgave ?

Anyone an idea?



Sub Inhouds_opgave()
'Met dank aan Nate Oliver
Dim ws As Worksheet, wsNw As Worksheet, N As Integer
Set wsNw = ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Sheets(1))
With wsNw
1: .Name = "Inhoudsopgave"
On Error GoTo 0
.[C4] = "Tabblad"
.[C4].Font.Size = 10
.[C4].Font.Bold = True
.[D4] = "Naam"
.[D4].Font.Size = 10
.[D4].Font.Bold = True

N = 6
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> .Name Then
.Cells(N, 4) = ws.Name
With .Cells(N, 3)
.Value = N - 5
.HorizontalAlignment = xlCenter
End With
.Hyperlinks.Add _
Anchor:=.Cells(N, 4), _
Address:="", _
SubAddress:="'" & ws.Name & "'!A1"
With ws
.[a3] = Sheets(1).Name
.[a3].Hyperlinks.Add _
Anchor:=.Cells(3, 1), _
Address:="", _
SubAddress:="'" & Sheets(1).Name & "'!A1"
End With
N = N + 1
End If
Next
End With
Exit Sub
2: Application.DisplayAlerts = False
Sheets("Inhoudsopgave").Delete
Application.DisplayAlerts = True
GoTo 1
End Sub



Thanks…

P.

[SamT]

Option Explicit
Sub Inhouds_opgave()
'Met dank aan Nate Oliver
Dim ws As Worksheet, wsNw As Worksheet, N As Integer
Set wsNw = ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Sheets(1))
With wsNw
.Name = "Inhoudsopgave"
'On Error GoTo 0
.[C4] = "Tabblad"
'.[C4].Font.Size = 10
'.[C4].Font.Bold = True
.[D4] = "Naam"
.[C4:D4].Font.Size = 10
.[C4:D4].Font.Bold = True
End With

N = 6
For Each ws In ThisWorkbook.Worksheets

If Not (ws.Name = wsNw.Name) Then
'On wsNw, Add Hyperlink to: ws
wsNw.Select
wsNw.Cells(N, 4) = ws.Name
wsNw.Cells(N, 3).Value = N - 5
wsNw.Cells(N, 3).HorizontalAlignment = xlCenter
wsNw.Hyperlinks.Add _
Anchor:=Cells(N, 4), _
Address:="", _
SubAddress:="'" & ws.Name & "'!A1"

'On ws, add hyperlink to: wsNw
ws.Select
ws.Cells(3, 1) = wsNw.Name
ws.Hyperlinks.Add _
Anchor:=Cells(3, 1), _
Address:="", _
SubAddress:="'" & wsNw.Name & "'!A1"


End If
N = N + 1
Next 'Next worksheet
Exit Sub
'2: Application.DisplayAlerts = False
' 'Sheets(wsNw).Delete
' Application.DisplayAlerts = True
' GoTo 1
End Sub

[domfootwear]

Pls try this code:


Option Explicit
Sub Inhouds_opgave()
Application.DisplayAlerts = False
'Met dank aan Nate Oliver
Dim ws As Worksheet, wsNw As Worksheet, N As Integer
Set wsNw = ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Sheets(1))
For Each ws In ThisWorkbook.Sheets
If ws.Name = "Inhoudsopgave" Then
ws.Delete
End If
Next ws
With wsNw
.Name = "Inhoudsopgave"
'On Error GoTo 0
.[C4] = "Tabblad"
'.[C4].Font.Size = 10
'.[C4].Font.Bold = True
.[D4] = "Naam"
.[C4:D4].Font.Size = 10
.[C4:D4].Font.Bold = True
End With

N = 4
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Invoice" And ws.Name <> "Debtor" And ws.Name _
<> "Customers" And ws.Name <> "Articles" Then
If Not (ws.Name = wsNw.Name) Then
'On wsNw, Add Hyperlink to: ws
wsNw.Select
wsNw.Cells(N, 3).Value = N - 4
wsNw.Cells(N, 3).HorizontalAlignment = xlCenter
wsNw.Cells(N, 4) = ws.Name
wsNw.Hyperlinks.Add _
Anchor:=Cells(N, 4), _
Address:="", _
SubAddress:="'" & ws.Name & "'!A1"

'On ws, add hyperlink to: wsNw
ws.Select
ws.Cells(3, 1) = wsNw.Name
ws.Hyperlinks.Add _
Anchor:=Cells(3, 1), _
Address:="", _
SubAddress:="'" & wsNw.Name & "'!A1"

End If
End If
N = N + 1
Next 'Next worksheet
Exit Sub
'2: Application.DisplayAlerts = False
' 'Sheets(wsNw).Delete
Application.DisplayAlerts = True
' GoTo 1

End Sub

[Pinokkio]

SamT & domfootwear,

Thanks for reply but all the sheets get a hyperlink?

P.

[SamT]

In my code, first sheet, "Inhoudsopgave", gets links to other sheets.

Other sheets get link to "Inhoudsopgave".

What do you want?

SamT

[Pinokkio]

Sorry for that.

Other sheets get link to "Inhoudsopgave".



This macro sheets, the "Invoice", "Customers", "Debtor" and "Articles" may not have hyperlinks to return to sheet "Inhoudsopgave ?

[SamT]

Take this part out
'On wsNw, Add Hyperlink to: ws
wsNw.Select
wsNw.Cells(N, 4) = ws.Name
wsNw.Cells(N, 3).Value = N - 5
wsNw.Cells(N, 3).HorizontalAlignment = xlCenter
wsNw.Hyperlinks.Add _
Anchor:=Cells(N, 4), _
Address:="", _
SubAddress:="'" & ws.Name & "'!A1"

[Pinokkio]

Thanks.

P.