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]

[VBA]
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"
.[C44].Font.Size = 10
.[C44].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

[/VBA]

[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
[VBA] '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"
[/VBA]

[Pinokkio]

Thanks.

P.