Copy a selection in a row instead of using cell.entirerowcopy

[fuslela]

Hello All,

I am using the following code which works well, the code monitors a column AA for the value "1" which is placed in the column as the result of a formula calculation

Private Sub Worksheet_Calculate()

For Each Cell In Sheets("Source").Range("AA2:AA50")
If Cell.Value = "1" Then
Cell.EntireRow.Copy
a = Sheets("Destination").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets("Destination").Range("A" & a).PasteSpecial xlPasteValues
End If
Next

End Sub

I would like to improve the code to do the following:
1) Instead of copy the entire row, only copy the row upto column AA so if aa2 is 1, the values from a2 to z2 are copied to another sheet
and
2) add another condition where either a cell/column is monitored in AB to see if that value is also 1, so AA and AB must have a value containing 1 for the macro to fire.

Thanks!

 

[Fluff]

How about

Private Sub Worksheet_Calculate()

For Each cell In Sheets("Source").Range("AA2:AA50")
If cell.Value = "1" And cell.Offset(, 1).Value = "1" Then
Range("A" & cell.Row).Resize(, 26).Copy
a = Sheets("Destination").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets("Destination").Range("A" & a).PasteSpecial xlPasteValues
End If
Next

End Sub

 

[fuslela]

How about

Private Sub Worksheet_Calculate()

For Each cell In Sheets("Source").Range("AA2:AA50")
If cell.Value = "1" And cell.Offset(, 1).Value = "1" Then
Range("A" & cell.Row).Resize(, 26).Copy
a = Sheets("Destination").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets("Destination").Range("A" & a).PasteSpecial xlPasteValues
End If
Next

End Sub

That's nice and tidy and something I hadn't thought about, nice use of offset! I will give it a try.
Many Thanks!

 

[Fluff]

You're welcome & thanks for the feedback.