Goalseek loop

[Dudditss]

Hi,
I have the following macro:

Sub
With ActiveSheet


For Each cll In Range("C6:G6")
cll.GoalSeek Goal:=10, ChangingCell:=Range("B3")
Range("B3").Select
Selection.Copy
Range("C9:G9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next cll
End With


End Sub

So I'm trying to change one cell "B3" to see the changes in output and have excel copy them out individually in the range C9:G9. The cells in C6:G6 is a product of B3 times numbers in cells C5:G5, i.e. C6=B3*C5.


My original macro looked like this, but I realised if I am to repeat this many times it I would be better off with something automatic:

Range("C6").GoalSeek Goal:=10, ChangingCell:=Range("B3")
ActiveWindow.SmallScroll Down:=-5
Range("X9").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=164
Range("C9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D6").GoalSeek Goal:=3, ChangingCell:=Range("B3")
ActiveWindow.SmallScroll Down:=-5
Range("B3").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=164
Range("D9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
... and the same for Column E to G.

Can anyone point me out in the right direction with the loop? Would be much appreciated.

[p45cal]

try:

  For Each cll In Range("C6:G6")
    cll.GoalSeek Goal:=10, ChangingCell:=Range("B3")
    cll.Offset(3).Value = Range("B3").Value
  Next cll