I am looking to paste a row of data onto a cell if the cell meets the
criteria. What I cannot seem to get this macro to do is move down to
the next cell, evaluate the contents, if it matches the criteria, paste
the copied row of data, then move onto the next cell until it
encounters a blank cell. Any ideas?

Range("$AP$2:$DZ$2").Select
Selection.Copy

Dim rg1 As Range
Set rg1 = Range("AP12")

Do Until IsEmpty(rg1)
If rg1 = "2" Then
ActiveSheet.Paste
Else
Set rg1 = rg1.Offset(1, 0)

End If
Loop
End Sub

Sub copyData()
Dim rg1 As Range, cell As Range
Dim rg2 As Range
Set rg2 = Range("$AP$2:$DZ$2")
Set rg1 = Range("AP12", Cells(Rows.Count, "AP").End(xlUp))
For Each cell In rg1
If cell.Value = 2 Then
rg2.Copy cell
End If
Next
End Sub

--
Regards,
Tom Ogilvy

"BigWave@AC" wrote:

I am looking to paste a row of data onto a cell if the cell meets the
criteria. What I cannot seem to get this macro to do is move down to
the next cell, evaluate the contents, if it matches the criteria, paste
the copied row of data, then move onto the next cell until it
encounters a blank cell. Any ideas?

Range("$AP$2:$DZ$2").Select
Selection.Copy

Dim rg1 As Range
Set rg1 = Range("AP12")

Do Until IsEmpty(rg1)
If rg1 = "2" Then
ActiveSheet.Paste
Else
Set rg1 = rg1.Offset(1, 0)

End If
Loop
End Sub

You have all of the pieces but you need to re-arrange them a bit... Try this...

Dim rg1 As Range
Set rg1 = Range("AP12")

Do Until rg1.Value = ""
If rg1 = "2" Then Range("$AP$2:$DZ$2").Copy Destination:=rng1
Set rg1 = rg1.Offset(1, 0)
Loop
End Sub


--
HTH...

Jim Thomlinson


"BigWave@AC" wrote:

I am looking to paste a row of data onto a cell if the cell meets the
criteria. What I cannot seem to get this macro to do is move down to
the next cell, evaluate the contents, if it matches the criteria, paste
the copied row of data, then move onto the next cell until it
encounters a blank cell. Any ideas?

Range("$AP$2:$DZ$2").Select
Selection.Copy

Dim rg1 As Range
Set rg1 = Range("AP12")

Do Until IsEmpty(rg1)
If rg1 = "2" Then
ActiveSheet.Paste
Else
Set rg1 = rg1.Offset(1, 0)

End If
Loop
End Sub

Thank you for the tip. works perfectly.


Jim Thomlinson wrote:
You have all of the pieces but you need to re-arrange them a bit... Try this...

Dim rg1 As Range
Set rg1 = Range("AP12")

Do Until rg1.Value = ""
If rg1 = "2" Then Range("$AP$2:$DZ$2").Copy Destination:=rng1
Set rg1 = rg1.Offset(1, 0)
Loop
End Sub


--
HTH...

Jim Thomlinson


"BigWave@AC" wrote:

I am looking to paste a row of data onto a cell if the cell meets the
criteria. What I cannot seem to get this macro to do is move down to
the next cell, evaluate the contents, if it matches the criteria, paste
the copied row of data, then move onto the next cell until it
encounters a blank cell. Any ideas?

Range("$AP$2:$DZ$2").Select
Selection.Copy

Dim rg1 As Range
Set rg1 = Range("AP12")

Do Until IsEmpty(rg1)
If rg1 = "2" Then
ActiveSheet.Paste
Else
Set rg1 = rg1.Offset(1, 0)

End If
Loop
End Sub

Thank you for the tip. works perfectly.


Jim Thomlinson wrote:
You have all of the pieces but you need to re-arrange them a bit... Try this...

Dim rg1 As Range
Set rg1 = Range("AP12")

Do Until rg1.Value = ""
If rg1 = "2" Then Range("$AP$2:$DZ$2").Copy Destination:=rng1
Set rg1 = rg1.Offset(1, 0)
Loop
End Sub


--
HTH...

Jim Thomlinson


"BigWave@AC" wrote:

I am looking to paste a row of data onto a cell if the cell meets the
criteria. What I cannot seem to get this macro to do is move down to
the next cell, evaluate the contents, if it matches the criteria, paste
the copied row of data, then move onto the next cell until it
encounters a blank cell. Any ideas?

Range("$AP$2:$DZ$2").Select
Selection.Copy

Dim rg1 As Range
Set rg1 = Range("AP12")

Do Until IsEmpty(rg1)
If rg1 = "2" Then
ActiveSheet.Paste
Else
Set rg1 = rg1.Offset(1, 0)

End If
Loop
End Sub