Paste selected cells

[Stevie787]

Hi,

I Have a piece of code below which loop searches an array for a specific string, once found it selects the cells which contain the text and loops until finished.

What I want to do now is copy the selected cells and paste them to another workbook but I'm having difficulty.


Any help will be appreciated

[FONT=Calibri][SIZE=3][COLOR=#000000]'if the searchreturns a cell[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    If Not c IsNothing Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        'note theaddress of first cell found[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        firstaddress =c.Address[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Do[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]           'FoundCells is the variable that will refer to all of the[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            'cellsthat are returned in the search[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            IfFoundCells Is Nothing Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                SetFoundCells = c[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            Else[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                SetFoundCells = Union(c, FoundCells)[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]            End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            'find thenext instance of "er99"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            Set c =.Cells.FindNext(c)[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Loop While Notc Is Nothing And firstaddress <> c.Address[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]        'after entiresheet searched, select all found cells[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]       FoundCells.Select[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        FoundCells.CopyWorksheets("Sheet2").Range("A1")[/COLOR][/SIZE][/FONT]

 

[Yongle]

Please post the complete sub
thanks

- click on # icon above post window first and then ...
[ CODE ] paste your code inside the tags [ /CODE ]

 

[Stevie787]

Apologies, I wasn't able to edit the post due to the timeout.

Please see the full sub below:

Sub FindError()


Dim c As Range, FoundCells As Range
Dim firstaddress As String


Application.ScreenUpdating = False
With Sheets("Sheet1")
    'find first cell that contains "er99"
    Set c = .Cells.Find(What:="er99", After:=.Cells(Rows.Count, 1), LookIn:=xlValues, LookAt:= _
    xlPart, MatchCase:=False)
    
    'if the search returns a cell
    If Not c Is Nothing Then
        'note the address of first cell found
        firstaddress = c.Address
        Do
            'FoundCells is the variable that will refer to all of the
            'cells that are returned in the search
            If FoundCells Is Nothing Then
                Set FoundCells = c
            Else
                Set FoundCells = Union(c, FoundCells)
                
            End If
            'find the next instance of "er99"
            Set c = .Cells.FindNext(c)
        Loop While Not c Is Nothing And firstaddress <> c.Address
                
        'after entire sheet searched, select all found cells
        FoundCells.Select
        FoundCells.Copy Worksheets("Sheet2").Range("A1")
        
        
    Else
        'if no cells were found in search, display msg
        MsgBox "No cells found."
    End If
End With
Application.ScreenUpdating = True


End Sub

My main issue is getting 'FoundCells.Copy Worksheets("Sheet2").Range("A1") to work correctly.