Need to read contents from cell 1

[vba317]

I am trying to create a table of contents in my spreadsheet. I have a macro that I need to read the contents of cells A1:A5 of all the sheets in the workbook and put the contents of those cells with a space starting in column B2. I am getting no errors but no information is going into the column B. Any help is appreciated.

Tom

Sub wrkbkSheetName()
Dim mainworkBook As Workbook
Dim i As Integer
Dim c As Integer
Dim x As Integer

Set mainworkBook = ActiveWorkbook

For i = 2 To mainworkBook.Sheets.Count
    mainworkBook.Sheets("TableofContents").Range("A" & i) = mainworkBook.Sheets(i).Name
Next i

'Count the last cell in Column A
x = ActiveSheet.UsedRange.Rows.Count
'Select Sheet 1
Sheets("TableofContents").Select
'Select The column to start with
Range("B2").Select
 
For c = 2 To x
    mainworkBook.Sheets("TableofContents").Range("B" & c) = mainworkBook.Sheets(c).Cells(1, 5)
Next c

End Sub

 

[vba317]

I am using Excel 2010

 

[vba317]

I have got some of the macro to work. Right now it is reading the first cell from the worksheets into the cell in the table of contents. What can I do to have it read the contents of all 5 cells with a space between them?

Tom

Sub wrkbkSheetName()
Dim mainworkBook As Workbook
Dim i As Integer
Dim c As Integer
Dim x As Integer

Set mainworkBook = ActiveWorkbook

For i = 2 To mainworkBook.Sheets.Count
    mainworkBook.Sheets("TableofContents").Range("A" & i) = mainworkBook.Sheets(i).Name
Next i

'Count the last cell in Column A
x = ActiveSheet.UsedRange.Rows.Count
'Select Sheet 1
Sheets("TableofContents").Select
'Select The column to start with
Range("B2").Select
 
For c = 2 To x
    ActiveWorkbook.Worksheets("TableofContents").Range("B" & c) = ActiveWorkbook.Worksheets(c).Cells(1, 5)
Next c

End Sub

 

[SkipVought]

Hi,

Well first of all, your c is looping from 2 to x, where x is the last row in some ActiveSheet, yet is used to loop thru sheets, and each sheet in the loop is putting the value of ONE CELL, E1, in column B???

Is that your intention?

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[vba317]

No, I want to read columns A -E in Row 1. I was hoping to get the results in one cell separated by a space. Maybe that isn't possible. I found a way to put the information into separate cells.

Sub wrkbkSheetName()
Dim mainworkBook As Workbook
Dim i As Integer
Dim c As Integer
Dim x As Integer

Set mainworkBook = ActiveWorkbook

For i = 2 To mainworkBook.Sheets.Count
    mainworkBook.Sheets("TableofContents").Range("A" & i) = mainworkBook.Sheets(i).Name
Next i

'Count the last cell in Column A
x = ActiveSheet.UsedRange.Rows.Count
'Select Sheet 1
Sheets("TableofContents").Select
'Select The column to start with
Range("B2").Select
 
For c = 2 To x
    ActiveWorkbook.Worksheets("TableofContents").Range("B" & c) = ActiveWorkbook.Worksheets(c).Range("A1").Value
    ActiveWorkbook.Worksheets("TableofContents").Range("C" & c) = ActiveWorkbook.Worksheets(c).Range("B1").Value
    ActiveWorkbook.Worksheets("TableofContents").Range("D" & c) = ActiveWorkbook.Worksheets(c).Range("C1").Value
    ActiveWorkbook.Worksheets("TableofContents").Range("E" & c) = ActiveWorkbook.Worksheets(c).Range("D1").Value
    ActiveWorkbook.Worksheets("TableofContents").Range("F" & c) = ActiveWorkbook.Worksheets(c).Range("E1").Value
Next c

End Sub

 

[vba317]

OK, it might not be the best way but I figured out how to combine all the contents into one cell.

Sub wrkbkSheetName()
Dim mainworkBook As Workbook
Dim i As Integer
Dim c As Integer
Dim x As Integer
Dim strHeader As String
Dim strCell1 As String
Dim strCell2 As String
Dim strCell3 As String
Dim strCell4 As String
Dim strCell5 As String
Dim strCellTotal As String

Set mainworkBook = ActiveWorkbook

For i = 2 To mainworkBook.Sheets.Count
    mainworkBook.Sheets("TableofContents").Range("A" & i) = mainworkBook.Sheets(i).Name
Next i

'Count the last cell in Column A
x = ActiveSheet.UsedRange.Rows.Count
'Select Sheet 1
Sheets("TableofContents").Select
'Select The column to start with
Range("B2").Select
 
For c = 2 To x
    strCell1 = ActiveWorkbook.Worksheets(c).Range("A1").Value
    strCell2 = ActiveWorkbook.Worksheets(c).Range("B1").Value
    strCell3 = ActiveWorkbook.Worksheets(c).Range("C1").Value
    strCell4 = ActiveWorkbook.Worksheets(c).Range("D1").Value
    strCell5 = ActiveWorkbook.Worksheets(c).Range("E1").Value
    strCellTotal = strCell1 & " " & strCell2 & " " & strCell3 & " " & strCell4 & " " & strCell5
    Range("B" & c) = strCellTotal
Next c

End Sub

 

[SkipVought]

For c = 2 To x
    Range("B" & c).ClearContents
    For i = 1 To 5
        Range("B" & c).Value = Range("B" & c).Value & ActiveWorkbook.Worksheets(c).Cells(1, i).Value & " "
    Next
    Range("B" & c) = Left(Range("B" & c).Value - Len(Range("B" & c).Value) - 1)
Next c

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[vba317]

Skip,
I tried your formula but I am getting a compile error. Argument not optional I have highlighted what is causing the error.

For c = 2 To x
    Range("B" & c).ClearContents
    For i = 1 To 5
        Range("B" & c).Value = Range("B" & c).Value & ActiveWorkbook.Worksheets(c).Cells(1, i).Value & " "
    Next
    Range("B" & c) = [Blue]Left [/Blue](Range("B" & c).Value - Len(Range("B" & c).Value) - 1)
Next c

 

[vba317]

I have changed the code to the following and it works great. Thanks !!!!!

 For c = 2 To x
    Range("B" & c).ClearContents
    For i = 1 To 5
        Range("B" & c).Value = Range("B" & c).Value & ActiveWorkbook.Worksheets(c).Cells(1, i).Value & " "
    Next
    Range("B" & c) = Left(Range("B" & c).Value, Len(Range("B" & c).Value) - 1)
Next c

 

[SkipVought]

Sorry, put a - rather than ,

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]