Loop several sheets - part 2 - dave

[al]

Have tried to adapt previous macro from previous post with different
range - but not working - can someone correct pls


Sub UpdateAllRevPeriod1()

Dim WS As Worksheet
Dim MinIndex As Long
Dim MaxIndex As Long
Dim RngToCopy As Range

ActiveWorkbook.PrecisionAsDisplayed = False
Application.ScreenUpdating = False 'Prevents the user from seeing
the screen
MinIndex = Worksheets("Pivot").Index
MaxIndex = Worksheets("End").Index

If MinIndex > MaxIndex Then
'swap them
MinIndex = MaxIndex
MaxIndex = Worksheets("Pivot").Index
End If

For Each WS In ActiveWorkbook.Worksheets
With WS
If .Index > MinIndex _
And .Index < MaxIndex Then
'do the work



Set RngToCopy = .Range("AM84:AM86")
RngToCopy.Copy
Range("AL84").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

End If
End With

Next WS

End Sub

 

[Mike H]

Hi,

Just a slight problem with the paste range syntax. Note that now 2 lines are
combined (no need to select) and prefixed with . to make it part of the with
statement

Sub UpdateAllRevPeriod1()

Dim WS As Worksheet
Dim MinIndex As Long
Dim MaxIndex As Long
Dim RngToCopy As Range

ActiveWorkbook.PrecisionAsDisplayed = False
Application.ScreenUpdating = False 'Prevents the user from seeingthe
screen
MinIndex = Worksheets("Pivot").Index
MaxIndex = Worksheets("End").Index


If MinIndex > MaxIndex Then
'swap them
MinIndex = MaxIndex
MaxIndex = Worksheets("Pivot").Index
End If

For Each WS In ActiveWorkbook.Worksheets
With WS
If .Index > MinIndex _
And .Index < MaxIndex Then
'do the work



Set RngToCopy = .Range("AM84:AM86")
RngToCopy.Copy
.Range("AL84").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

End If
End With

Next WS

End Sub


Mike

 

[Dave Peterson]

You dropped the dots in front of the range objects. Without those dots and the
corresponding "With" statements, the ranges will refer to the active sheet (if
the code is in a General module).

And you can only select a range on the sheet that is active. The good thing is
that you don't need to select a range for your code to work.

Untested, but it did compile:

Option Explicit
Sub UpdateAllRevPeriod1()

Dim WS As Worksheet
Dim MinIndex As Long
Dim MaxIndex As Long
Dim RngToCopy As Range

ActiveWorkbook.PrecisionAsDisplayed = False
'Prevents the user from seeing the screen
Application.ScreenUpdating = False

MinIndex = Worksheets("Pivot").Index
MaxIndex = Worksheets("End").Index

If MinIndex > MaxIndex Then
'swap them
MinIndex = MaxIndex
MaxIndex = Worksheets("Pivot").Index
End If

For Each WS In ActiveWorkbook.Worksheets
With WS
If .Index > MinIndex _
And .Index < MaxIndex Then
'do the work
Set RngToCopy = .Range("AM84:AM86")
RngToCopy.Copy
.Range("AL84").PasteSpecial Paste:=xlPasteValues
End If
End With
Next WS

'just do it once at the end
Application.CutCopyMode = False

End Sub

 

[al]

You dropped the dots in front of the range objects. Without those dots and the
corresponding "With" statements, the ranges will refer to the active sheet (if
the code is in a General module).

And you can only select a range on the sheet that is active. The good thing is
that you don't need to select a range for your code to work.

Untested, but it did compile:

Option Explicit
Sub UpdateAllRevPeriod1()

Dim WS As Worksheet
Dim MinIndex As Long
Dim MaxIndex As Long
Dim RngToCopy As Range

ActiveWorkbook.PrecisionAsDisplayed = False
'Prevents the user from seeing the screen
Application.ScreenUpdating = False

MinIndex = Worksheets("Pivot").Index
MaxIndex = Worksheets("End").Index

If MinIndex > MaxIndex Then
'swap them
MinIndex = MaxIndex
MaxIndex = Worksheets("Pivot").Index
End If

For Each WS In ActiveWorkbook.Worksheets
With WS
If .Index > MinIndex _
And .Index < MaxIndex Then
'do the work
Set RngToCopy = .Range("AM84:AM86")
RngToCopy.Copy
.Range("AL84").PasteSpecial Paste:=xlPasteValues
End If
End With
Next WS

'just do it once at the end
Application.CutCopyMode = False

End Sub

thxs u all for your support!!