Is there a way to copy Find and Replace contents?

[Tigerexcel]

As the title says can this be done? I've seen various internet posts that you select the data and then use Ctrl + C or some other copying method, as soon as I do that the actual contents are no longer kept and when I paste, there's nothing there.

 

[shaowu459]

Yes in the same workbook. These are non-contiguous ranges so I guess VBA is necessary which is ok if someone has a solution.

If you need macro in post 3, i will post the code later.

 

[Michael M]

You will need to provide more information on where to copy from AND where to paste

 

[Tigerexcel]

Thanks shaowu.
Michael, the macro will need to copy all the cells actioned by the Find and Replace process onto a new worksheet.

 

[Michael M]

Rather than copy and paste. Why not simply write the new values to the required cells via VBA ?

 

[Michael M]

Thanks shaowu.
Michael, the macro will need to copy all the cells actioned by the Find and Replace process onto a new worksheet.

In the same locations on the new sheet??

 

[Tigerexcel]

Rather than copy and paste. Why not simply write the new values to the required cells via VBA ?

But how are all these values/text captured?

 

[Tigerexcel]

In the same locations on the new sheet??

No, anywhere is fine.

 

[Michael M]

So, maybe like this

Sub MM1()
Dim c As Range, n As Long
n = 1
For Each c In Selection
    Sheets("Sheet2").Range("A" & n) = c.Value
    n = n + 1
Next c
End Sub

 

[Tigerexcel]

So, maybe like this

Sub MM1()
Dim c As Range, n As Long
n = 1
For Each c In Selection
    Sheets("Sheet2").Range("A" & n) = c.Value
    n = n + 1
Next c
End Sub

Hi Michael,

I've copied this macro to the sheet required and it when i try to activate it, it is dimmed and won't let me run it, in fact it doesn't run in any sheet.

 

[shaowu459]

Below is my code for multiple ranges copy and paste.
1) Ctrl+F find all cells you want to copy
2) in the result box, CTRL+A select all cells finded, close the Find and Replace dialogue
3) Run the macro and select a single cell, click OK.
please refer to my above post GIF for the steps.

Public Sub MultiCopy(control As IRibbonControl)
    On Error Resume Next
    Dim SRange() As Range, UPRange As Range, TRange As Range
    Dim i As Long, AreaNum As Long
    Dim MinR As Long, MinC As Long

    AreaNum = Selection.Areas.Count
    ReDim SRange(1 To AreaNum)

    MinR = ActiveSheet.Rows.Count
    MinC = ActiveSheet.Columns.Count

    For i = 1 To AreaNum
        Set SRange(i) = Selection.Areas(i)
        If SRange(i).Row < MinR Then MinR = SRange(i).Row
        If SRange(i).Column < MinC Then MinC = SRange(i).Column
    Next i

    Set UPRange = Cells(SRange(1).Row, SRange(1).Column)

    Set TRange = Application.InputBox(prompt:="Select upper left cell of target range to paste:", Title:="Copy Multiple Selection", Type:=8)

    Application.ScreenUpdating = False
    For i = 1 To AreaNum
        SRange(i).Copy
        TRange.Offset(SRange(i).Row - MinR, SRange(i).Column - MinC).PasteSpecial Paste:=xlPasteValues
    Next i
    Application.ScreenUpdating = True
End Sub