VBA Loop and copy cells to sheet

[SGMike]

Hi, in excel 2007 trying to loop through (un-fixed length) column (say C) and where row value matches (say "High"), then transfer value of cells Bx and Dx to sheet "transfer", where x is the row# where the matches are found. Assume "transfer" exists.

 

[VoG]

Try

Sub test()
Dim LR As Long, i As Long
With ActiveSheet
    LR = .Range("C" & Rows.Count).End(xlUp).Row
    For i = 1 To LR
        If .Range("C" & i).Value = "High" Then
            .Range("B" & i).Copy Destination:=Sheets("Transfer").Range("B" & i)
            .Range("D" & i).Copy Destination:=Sheets("Transfer").Range("D" & i)
        End If
    Next i
End With
End Sub

 

[hiker95]

SGMike,

You have two respones here:
http://www.ozgrid.com/forum/showthread.php?t=154941

 

[SGMike]

Thank you VoG; it's almost there. The code producs the desired copies of desired cells in the right sheet; 2 issues: 1) ideally the copied cells from each row would be on sequential rows rather than as now in same rows as the ones they were copied from; 2) the copying assumes that the cells contain values rather than formulas - what if the cell being copied contains formula?

 

[VoG]

Try

Sub test()
Dim LR As Long, i As Long
With ActiveSheet
    LR = .Range("C" & Rows.Count).End(xlUp).Row
    For i = 1 To LR
        If .Range("C" & i).Value = "High" Then
            .Range("B" & i).Copy
            Sheets("Transfer").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
            .Range("D" & i).Copy
            Sheets("Transfer").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
        End If
    Next i
End With
End Sub

 

[SGMike]

VoG - much obliged; simple and elegant; does the trick

 

[VoG]

Good. Please read this http://www.excelguru.ca/node/7