PDA

View Full Version : [SOLVED] For Loop help



Visual Newby
04-03-2012, 03:03 AM
Hi, I have just written a copy and paste macro. I was hoping to copy and paste all cells in the defined range that meet the condition in the code but unfortunately the macro stops after it met the condition for the first time. Could anyone show me where I am going wrong?

Thanks ion advance!

Sub Matching()
Dim wbk As Workbook
Set wbk = ThisWorkbook
Dim wks As Worksheet
Set wks = wbk.Worksheets("Sheet 1")
Dim cell As Range
Dim rng As Range
Set rng = wks.Range(wks.Range("U2"), wks.Range("U65000").End(xlUp))
Dim targetCell As Range
Set targetCell = wks.Range("AH2")
For Each cell In rng
If cell.Interior.ColorIndex = 6 Then
cell.Copy
targetCell.Activate
ActiveCell.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Set targetCell = targetCell.Offset(1, 0)
Exit For
End If
Next
End Sub

omp001
04-03-2012, 04:05 AM
Hi.
Try removing the red line.

Set targetCell = targetCell.Offset(1, 0)
Exit For
End If

Visual Newby
04-03-2012, 05:42 AM
Perfect, thanks very much! :)