Table content

tuytuy

Board Regular
Joined
Mar 28, 2013
Messages
75
Hi,
i would like to write a code that creats a table of content.
So the code would take the value of B1 on each sheet, and copy it in a new sheet called Table_of_Content.
Here is what i wrote so fare but it doesn't work:
Code:
' Creating table of content


Dim work**** As Worksheet
Set work**** = Sheets.Add
Sheets.Add.Name = "Table_Of_Content"




' Filling TOC
ActiveWorkbook.Sheets("Table_Of_Content").Activate
Dim WorkS As Worksheet
    For Each WorkS In ActiveWorkbook.Worksheets
    Range("B1").Copy
ActiveSheet.Paste
Application.CutCopyMode = False
    Next WorkS
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
No need to copy and paste. Just set the cell data directly.

Code:
Sub TableOfContents()

' Creating table of content
Dim WorkS As Worksheet
Dim NewRW As Long
Sheets.Add.Name = "Table_Of_Content"

' Filling TOC
ActiveWorkbook.Sheets("Table_Of_Content").Activate
NewRW = 1
For Each WorkS In ActiveWorkbook.Worksheets
    If WorkS.Name <> "Table_Of_Content" Then
        Sheets("Table_Of_Content").Cells(NewRW, "A") = WorkS.Cells(1, "B")
        NewRW = NewRW + 1
    End If
Next WorkS

End Sub
 
Upvote 0

04.02.2013-21.50.16 - sdruley's library

Code:
Option Explicit
Dim workS As Worksheet
' Creating table of contents
Sub TOC()
Dim i As Integer
Application.DisplayAlerts = False
On Error Resume Next
Sheets.Add.Name = "Table_Of_Contents"
i = 0
' Filling TOC
ActiveSheet.Delete
ActiveWorkbook.Sheets("Table_Of_Contents").Activate
    For Each workS In ActiveWorkbook.Worksheets
    i = i + 2
    If Left(workS.Name, 5) <> "Table" Then
    Sheets("Table_Of_Contents").Cells(8 + i, 4).Value = Sheets(workS.Name).Cells(2, 2).Value
    End If
    Next
Application.DisplayAlerts = True
End Sub
 
Upvote 0
No need to copy and paste. Just set the cell data directly.

Code:
Sub TableOfContents()

' Creating table of content
Dim WorkS As Worksheet
Dim NewRW As Long
Sheets.Add.Name = "Table_Of_Content"

' Filling TOC
ActiveWorkbook.Sheets("Table_Of_Content").Activate
NewRW = 1
For Each WorkS In ActiveWorkbook.Worksheets
    If WorkS.Name <> "Table_Of_Content" Then
        Sheets("Table_Of_Content").Cells(NewRW, "A") = WorkS.Cells(1, "B")
        NewRW = NewRW + 1
    End If
Next WorkS

End Sub

Working fine thanks
 
Upvote 0

04.02.2013-21.50.16 - sdruley's library

Code:
Option Explicit
Dim workS As Worksheet
' Creating table of contents
Sub TOC()
Dim i As Integer
Application.DisplayAlerts = False
On Error Resume Next
Sheets.Add.Name = "Table_Of_Contents"
i = 0
' Filling TOC
ActiveSheet.Delete
ActiveWorkbook.Sheets("Table_Of_Contents").Activate
    For Each workS In ActiveWorkbook.Worksheets
    i = i + 2
    If Left(workS.Name, 5) <> "Table" Then
    Sheets("Table_Of_Contents").Cells(8 + i, 4).Value = Sheets(workS.Name).Cells(2, 2).Value
    End If
    Next
Application.DisplayAlerts = True
End Sub

hmm doesn't seem to work nothing is created.
why is there a button to create the table ? couldn't it be automatic ?
 
Upvote 0
Code:
Option Explicit
Dim workS As Worksheet
' Creating table of contents
Sub TOC()
Dim i As Integer
Application.DisplayAlerts = False
On Error Resume Next
Sheets.Add.Name = "Table_Of_Contents"
i = 0
' Filling TOC
ActiveSheet.Delete
ActiveWorkbook.Sheets("Table_Of_Contents").Activate
    For Each workS In ActiveWorkbook.Worksheets
    i = i + 2
    If Left(workS.Name, 5) <> "Table" Then
    Sheets("Table_Of_Contents").Cells(8 + i, 4).Value = Sheets(workS.Name).Cells(2, 2).Value
    End If
    Next
Application.DisplayAlerts = True
End Sub

this bit of your code:

Option Explicit
Dim workS As Worksheet
' Creating table of contents

isn't in the sub and will therefore not be taken into account. How does this work ?
 
Last edited:
Upvote 0
Change

Code:
[COLOR=#333333][I] Sheets("Table_Of_Contents").Cells(8 + i, 4).Value = Sheets(workS.Name).Cells(2, 2).Value[/I][/COLOR]

to

Code:
[COLOR=#333333][I] Sheets("Table_Of_Contents").Cells(8 + i, 4).Value = Sheets(workS.Name).Cells(1, 2).Value[/I][/COLOR]

I had the read point at B2 instead of B1

Also, the button is there so you can decide when to run the code. You can remove the button and decide to run the macro by locating it and clicking run.

The following:

HTML:
Option Explicit
Dim workS As Worksheet
' Creating table of contents

is located above the sub in case another macro is created in this same module and needs to refer to the variable workS. If you prefer, you can move it inside the procedure. Option Explicit belongs where it is since it represents a discipline to DIM and all used variables.
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,213
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top