使用 excel 中的 vba 从“查找和替换”框或搜索框中复制和导出数据

Question

Actually I dont have any spesific data to referred, only just wonder if it can be done to export the data to another workbook (whether open or closed) by click on selected row in searchbox from active workbook.

Let's says, the data found in active workbook searchbox is in Row 7, then when click on it (in searchbox) so the data will be exported to another workbook. Not necessery to export all the data, maybe need it in Cell D7, F7 & K7 only to export. And target workbook will filled with the exported data to B4(D7), G8(F7) & L9(K7).

Can it be done using VBA codes? Maybe have to created Userform as a 'Find and Replace' box? Maybe there is another way can make it done? Thank you very much in advance if you accept this challenge and wish you good luck.

Post code here:

Answer 1

Yes, it can be done using VBA. This can get you started.

Example

This example finds all cells in the range A1:A500 on worksheet one that contain the value 2, and changes it to 5.

With Worksheets(1).Range("a1:a500") 
    Set c = .Find(2, lookin:=xlValues) 
    If Not c Is Nothing Then 
        firstAddress = c.Address 
        Do 
            c.Value = 5 
            Set c = .FindNext(c) 
        Loop While Not c Is Nothing
    End If 
End With

Look here for source and more: https://docs.microsoft.com/en-us/office/vba/api/excel.range.find

Answer 2

Private Sub ListBox_Results_Click()
Dim strAddress As String
Dim strSheet As String
Dim strCell As String
Dim l As Long
Dim lLastRow As Long
Const sRESULTS As String = "Results Sheet" 
For l = 0 To ListBox_Results.ListCount
If ListBox_Results.Selected(l) = True Then
strAddress = ListBox_Results.List(l, 1)
strSheet = Replace(Mid(strAddress, 1, InStr(1, strAddress, "!") - 1), "'", "")
Worksheets(strSheet).Select
Worksheets(strSheet).Range(strAddress).Select

 With Worksheets(sRESULTS) lLastRow =.Range("A" &.Rows.Count).End(xlUp).Row + 1.Range("A" & lLastRow).Value = Worksheets(strSheet).Range(strAddress).Value.Range("B" & lLastRow).Value = strAddress.Range("C" & lLastRow).Value = Now

End With
GoTo EndLoop
End If
Next l
EndLoop:
End Sub