Loop thru all sheets and copy a value

[dazz]

Hi,

I have the following, and want it loop through the sheets, and in each sheet, copy the value in B1 down the rest of column B (active cells). However it is copying the value in B1 sheet 1 to all the sheets. But this is not what I want. In sheet 2 , I want B1 from sheet 2 copied down. In sheet 3 , I want B1 from sheet 3 copied down, ect. Appreciate any help..thanks!

Sub AddColumn()


Dim sht As Worksheet
Dim Lastrow As Long
Dim Pasterange As String
Dim cnt As Integer


For Each sht In ActiveWorkbook.Worksheets
    sht.Range("A1").EntireColumn.Insert xlShiftToRight
    sht.Cells(1, 1) = "=Left(R2C13,13)"
    sht.Cells(1, 2) = "=right(R3C3,11)"
    Lastrow = Range("C" & Rows.Count).End(xlUp).Row
    cnt = sht.Cells.SpecialCells(xlCellTypeLastCell).Row
    Let Pasterange = "B2:" & "B" & cnt
    Range("B1").Select
    Selection.Copy
    Range(Pasterange).Select
    sht.Range(Pasterange).PasteSpecial Paste:=xlValues
Next sht


End Sub

[mdmackillop]

You need to qualify all your ranges etc.

Sub AddColumn()
    Dim sht As Worksheet
    'Dim Lastrow As Long
    Dim Pasterange As Range
    Dim cnt As Integer
    For Each sht In ActiveWorkbook.Worksheets
        With sht
        .Range("A1").EntireColumn.Insert xlShiftToRight
        .Cells(1, 1) = "=Left(R2C13,13)"
        .Cells(1, 2) = "=right(R3C3,11)"
        'Lastrow = .Range("C" & Rows.Count).End(xlUp).Row
        cnt = sht.Cells.SpecialCells(xlCellTypeLastCell).Row
        Set Pasterange = .Range("B2:" & "B" & cnt)
        .Range("B1").Copy
        Pasterange.PasteSpecial Paste:=xlValues
        End With
    Next sht
End Sub

[dazz]

thank you mdmackillop!!!! works great!