Simple problem with code
 

I've got a mutli tab workbook, one sheet is titled PAYMENT LIST. I'm using
this code to copy all rows with DISC in Col A to a new sheet titled DISC
PMTS. For some reason this isn't working and I just can't seem to figure out
why. Any help you can give me is certainly appreciated.

Sub CopyDiscPaymentsToNewSheet()

Dim i As Long, Sh As Worksheet
With Worksheets("PAYMENT LIST")
Set rng = .Range(.Cells(1, "A"), _
.Cells(Rows.Count, "A").End(xlUp))
End With
i = 1

Set Sh = Worksheets("DISC PMTS")
For Each cell In rng

If UCase(Trim(cell.Offset(0, 1).Value)) = "DISC PMTS" Then
cell.EntireRow.Copy Sh.Cells(i, 1)
i = i + 1
End If

Next

End Sub

Simple problem with code
 

First you are looking at cell.Offset(0, 1).Value which is column B rather
than column A.


Second you are looking for DISC PMTS to be in the cell rather than DISC
--
Gary's Student


"JOUIOUI" wrote:

I've got a mutli tab workbook, one sheet is titled PAYMENT LIST. I'm using
this code to copy all rows with DISC in Col A to a new sheet titled DISC
PMTS. For some reason this isn't working and I just can't seem to figure out
why. Any help you can give me is certainly appreciated.

Sub CopyDiscPaymentsToNewSheet()

Dim i As Long, Sh As Worksheet
With Worksheets("PAYMENT LIST")
Set rng = .Range(.Cells(1, "A"), _
.Cells(Rows.Count, "A").End(xlUp))
End With
i = 1

Set Sh = Worksheets("DISC PMTS")
For Each cell In rng

If UCase(Trim(cell.Offset(0, 1).Value)) = "DISC PMTS" Then
cell.EntireRow.Copy Sh.Cells(i, 1)
i = i + 1
End If

Next

End Sub