An easier macro to Copy value in cell c if valule in b =no.

[Whatever20030]

I am doing a quality check sheet for work and if say if any cells in Column B contain "no" in them i need the corresponding cell to in Column C to be copied on to a seperate sheet starting in a specific row then going down for every row where there is data.

I.E. Cell B3 = no Cell C is copied "wrong date entered" and pasted on Results Sheet in cell A7 and so on.

Have got it working looking like this

Sheets("Checking Sheet").Select
If Range("$B3") = "No" Then
Range("$C3").copy
Sheets("Results Sheet").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If
Sheets("Checking Sheet").Select
If Range("$B4") = "No" Then
Range("$C4").copy
Sheets("Results Sheet").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If
Sheets("Checking Sheet").Select
If Range("$B5") = "No" Then
Range("$C5").copy
Sheets("Results Sheet").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If

However pretty sure there has to be an easier way of doing it as don't fancy doing the whole macro like this as there is about 63 cells.

Any help would be appreciated.

thanks

[xladept]

Try this:

Sub Whatever(): Dim wc As Worksheet, wr As Worksheet, r As Long, c As Long
Set wc = Sheets("Checking Sheet"): Set wr = Sheets("Results Sheet")
r = wr.Range("A" & Rows.count).End(xlUp).Row + 1
For c = 3 To wc.Range("B" & Rows.count).End(xlUp).Row
If LCase(wc.Cells(c, 2)) = "no" Then wc.Cells(c, 3).Copy wr.Cells(r, 1)
r = r + 1: Next c: End Sub

BTW:Administrative Note:

Welcome to the forum.

You need to include code tags around your code.

Please take a moment to add the tags. Posting code between tags makes your code much easier to read and copy for testing, and it also maintains VBA formatting.

Please see Forum Rule #2 about code tags and adjust accordingly. Click on Edit to open your post, then highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here

Please attend to this as I should not have offered any code.

[Richard Buttrey]

Another option. I'm assuming there's a column label in B1 on the Checking Sheet

Sub CopyNos()
    With Sheets("Checking Sheet").Range("B1")
        .CurrentRegion.AutoFilter field:=1, Criteria1:="no"
        .CurrentRegion.Offset(1, 1).Resize(, 1).SpecialCells(xlCellTypeVisible).Copy Sheets("Results Sheet").Range("A" & Rows.Count).End(xlUp).Cells(2, 1)
    End With


End Sub