Problems with developing an Array of information. 2

[gjsala]

My code can identify a row of information but I would like to add this information to a new sheet. The problem is the rows that are captured on the old worksheet keeping overwriting itself on the new sheet. How can I not overwrite the same row? Thanks in advance! Here is the code:

Sub Am()
Dim r, r2 As Long
Dim numRows As Integer
Dim myRange, twoMyRange As Range
Dim numR, twoNumR As Integer
Dim target As Long

Sheets.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "AM"
Worksheets("Test").Activate

Set myRange = ActiveSheet.Range("A1:A65000")
numR = Application.CountA(myRange)
    For r = 2 To numR + 1
        If Mid(Cells(r + 1, 2), 19, 2) = "AM" Then
            Rows(r).Select
            Selection.Copy
            Worksheets("AM").Activate
        
            Set twoMyRange = ActiveSheet.Range("A1:A65000")
            twoNumR = Application.CountA(twoMyRange)
                For r2 = 1 To twoNumR + 1
                     ActiveSheet.Paste
                Next r2
            Worksheets("Test").Activate
        End If
    Next r
End Sub

 

[SkipVought]

Hi,

Use objects to their advantage. Avoid using the Select and Activate method for navigating a workbook...

Sub Am()
'specify an AS for each declaration
Dim r as long, r2 As Long
Dim numRows As Integer
Dim myRange as range, twoMyRange As Range
Dim numR as integer, twoNumR As Integer
Dim target As Long
dim wsThis as worksheet, wsNew as worksheet

set wsthis = activesheet

set wsnew = Sheets.Add
wsnew.Sheets("Sheet1").Name = "AM"

Set myRange = wsthis.Range("A1:A65000")
numR = myrange.count
    For r = 2 To numR + 1
        If Mid(wsthis.Cells(r + 1, 2), 19, 2) = "AM" Then
            wsthis.Rows(r).Copy 
        
            r2 = wsnew.Range("A1").currentregion.rows.count + 1
            wsnew.cells(r2,1).paste
        End If
    Next r

   set wsnew = nothing
   set wsthis = nothing
'set all other objects to nothing
End Sub

Skip,

_[red][/red]

 

[gjsala]

Thanks for the quick response! I ran into a problem when I ran your code, it gave me a compile error: Method or data member not found at line

wsnew.Sheets("Sheet1").Name = "AM"

What should I change next?

 

[PHV]

Try this instead:
wsnew.Name = "AM"

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[gjsala]

New code worked but the following code gave this error" Run time error 438, object doesn't support this property or method" Here is the line:

 wsNew.Cells(r2, 1).Paste

Thanks.

 

[SkipVought]

Try this...

wsNew.Cells(r2, 1).PasteSpecial xlpastevalues

and sorry that I missed the sheet nameing.

Skip,

_[red][/red]