Pasting Sheet Title as first column

[khawarameer]

I have work book with sevaral sheets. The contain identical columns. I want the sheet titles to be inserted as first columns in the respective sheets. Can any one give me the code for this.

Regards

 

[StuLux]

In cell A1 enter the formula

=CELL("filename",D1)

(Reference to D1 could be to any cell on the sheet) - this will give the full file path, workbook and sheet name (once the file has been saved)
In cell B1 enter the formula

=RIGHT(A1,(LEN(A1)-(FIND("]",A1,1))))

This will return the sheet name only from the formula in cell A1 i.e. all characters after the ] character.

 

[khawarameer]

Thanks Stuart it was great.

But I was hoping for a VBA Code. You see i have lot of sheets and i just cant insert a column in every sheet and paste the formula and then apply to all rows (It will take a long time). Instead a VBA Code will be handy to do all that. Can you provide me with a Code.

 

[khawarameer]

Hi,

I have tried to make a VBA Code using Macro Recorder and some modifications. Here is the Code;

Sub Test()
Dim Lastrow As Long, SheetNum As Integer, i As Integer

For i = 1 To SheetNum
Sheets(i).Select
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
ActiveCell.FormulaR1C1 = _
"=RIGHT(CELL(""filename""),(LEN(CELL(""filename""))-(FIND(""]"",CELL(""filename""),1))))"
Range("A2").Select
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
Selection.AutoFill Destination:=Range("A2:A" & Lastrow)
Next i
End Sub

when i run this code it gives me this error;

Run-time error '1004':
AutoFill method of Range cass failed

What could be the fault.

 

[Norie]

What are you actually trying to do?

Why have you based LastRow on a column you've inserted, which will presumamby be blank apart from the formula you enter in A2?

 

[khawarameer]

My aim is to Obtain Lastrow that contains data in each sheet. actually I have several sheet in my work book. Though columns are same in each sheet but rows are different therefore a constant value for rows will not work. that's why i placed this Lastrow variable to obtain last row containing data.

 

[Norie]

But you appear to be basing the last row on a column that is inserted via code.

 

[khawarameer]

I have changed the code a little bit. Now it is working (i.e. Copying Sheet Title in the first column). This is the code.

Sub Test()
Dim Lastrow As Long, SheetNum As Integer, i As Integer

SheetNum = Worksheets.Count
For i = 1 To SheetNum
Sheets(i).Select
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("Sheets(i)!a2").Select
ActiveCell.FormulaR1C1 = _
"=RIGHT(CELL(""filename""),(LEN(CELL(""filename""))-(FIND(""]"",CELL(""filename""),1))))"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A" & Lastrow)
Next i
End Sub

Now i have another problem. Once i run this macro the title of active sheet is copied in all sheets. I think the formula to copy sheet titles need to be changed.

ActiveCell.FormulaR1C1 = _
"=RIGHT(CELL(""filename""),(LEN(CELL(""filename""))-(FIND(""]"",CELL(""filename""),1))))"

But i don't know any other suitable replacement for that formula. Can any one help me now.

 

[Norie]

Why are you using the formula in the first place?

Why can't you just get the worksheet name using Sheets(i).Name?

Sub Test()
Dim ws As Worksheet
Dim Lastrow As Long, SheetNum As Long, I As Long
 
    SheetNum = Worksheets.Count
 
    For I = 1 To SheetNum

        Set ws = Sheets(I)
        With ws

            Lastrow = .Cells(Rows.Count, 1).End(xlUp).Row

            .Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

            .Range("A2:A" & Lastrow) = ws.Name
        End With
    Next I
 
End Sub

PS I still don't see how you can use the inserted column to find the last row of data, perhaps I'm missing something.