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!