loop through each row of a spreadsheet and based on the value of cells

[phani2121]

<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o> Hi all,</o>
<o> </o>
I want to loop through each row of a spreadsheet and based on the value of cells in column b, copy the contents of the cells in columns a,b , d, h, j, and copy it to another workbook. I have it working where I can copy the entire row but that won't work for my current project. Here is the code to get the entire row:

Sub copyRows_1()

Dim SiteCol As Range, Cell As Object

Set SiteCol = Range("B4:B700") 'Range containing pc names

For Each Cell In SiteCol

If IsEmpty(Cell) Then
Exit Sub
End If

If Cell.Value Like "PC00*" Then
Cell.EntireRow.Copy
Windows("pcMaster.xls").Activate
ActiveSheet.Range("A65536").End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste

End If
Next
End Sub

Thanks in Advance.

 

[meldoc]

Hello

Try the below on a COPY, of your data.

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> copyRows_1()<br><SPAN style="color:#00007F">Dim</SPAN> wb <SPAN style="color:#00007F">As</SPAN> Workbook<br><SPAN style="color:#00007F">Dim</SPAN> wbpc <SPAN style="color:#00007F">As</SPAN> Workbook<br><SPAN style="color:#00007F">Dim</SPAN> ws <SPAN style="color:#00007F">As</SPAN> Worksheet<br><SPAN style="color:#00007F">Dim</SPAN> wspc <SPAN style="color:#00007F">As</SPAN> Worksheet<br><SPAN style="color:#00007F">Set</SPAN> wb = Workbooks("test45.xls")<br><SPAN style="color:#00007F">Set</SPAN> wbpc = Workbooks("pcMaster.xls")<br><SPAN style="color:#00007F">Set</SPAN> ws = wb.Sheets(1)<br><SPAN style="color:#00007F">Set</SPAN> wspc = wbpc.Sheets(1)<br><br>  ro = 1<br>  lr = ws.Cells(Rows.Count, "B").End(xlUp).Row<br>    <SPAN style="color:#00007F">For</SPAN> i = 4 <SPAN style="color:#00007F">To</SPAN> lr<br>      <SPAN style="color:#00007F">If</SPAN> ws.Cells(i, "B") <SPAN style="color:#00007F">Like</SPAN> "PC00*" <SPAN style="color:#00007F">Then</SPAN><br>        ws.Cells(i, "A").Resize(, 2).Copy wspc.Cells(ro, "A")<br>        ws.Cells(i, "D").Copy wspc.Cells(ro, "D")<br>        ws.Cells(i, "H").Copy wspc.Cells(ro, "H")<br>        ws.Cells(i, "J").Copy wspc.Cells(ro, "J")<br>        ro = ro + 1<br>      <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> i<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[phani2121]

Hi,

Thank you...its working.....