（已解决）将search结果写入现有searchfunction中的新工作表

的回答。

我有一个非常基本的VBA技能集，所以我会开始说我非常感谢任何人谁可以花时间来帮助我的问题。 在这个一般的主题上有很多post，但我正在寻找一个已经存在的代码，我正在使用，真的很喜欢。

下面的代码返回消息框中search值（A）的相关值（B：C）。 我需要一个额外的脚本来获取消息框search结果，并将它们（和search到的值一起）写入另一个表格（比如我们称之为“TVD REPORT”）。 我仍然想保留下面的代码来显示消息，而且还要存储search结果。 这看起来很简单，但是把现有的代码整合到我的头上。

注意：表单（“数据”）。select是为了保持脚本在后台运行，每次事件被执行时，因为表单将被保护。

Dim rngVis As Range Dim VisCell As Range Dim sFind As String sFind = InputBox("Please enter the MD Depth to find the matching TVD depth and VS footage.") If Len(Trim(sFind)) = 0 Then Exit Sub 'Pressed cancel Application.ScreenUpdating = False Sheets("MD REPORT").Select With Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns("A")) .AutoFilter 1, sFind On Error Resume Next Set rngVis = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) On Error GoTo 0 .AutoFilter End With 'appended script to paste results into new sheet goes here?? Sheets("Data").Select Application.ScreenUpdating = True If rngVis Is Nothing Then MsgBox sFind & " could not be found." Else For Each VisCell In rngVis.Cells MsgBox "TVD: " & VisCell.Worksheet.Cells(VisCell.Row, "B").Text & vbNewLine & _ "VS: " & VisCell.Worksheet.Cells(VisCell.Row, "C").Text Next VisCell End If End Sub 

Answer 1

 Sub Zach() Dim rngVis As Range Dim VisCell As Range Dim sFind As String Dim rpt As Worksheet Set rpt = ActiveWorkbook.Worksheets("TVD REPORT") 'assuming this sheet is in same workbook Dim tvd As String Dim vs As String sFind = InputBox("Please enter the MD Depth to find the matching TVD depth and VS footage.") If Len(Trim(sFind)) = 0 Then Exit Sub 'Pressed cancel Application.ScreenUpdating = False Sheets("MD REPORT").Select With Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns("A")) .AutoFilter 1, sFind On Error Resume Next Set rngVis = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) On Error GoTo 0 .AutoFilter End With Sheets("Data").Select Application.ScreenUpdating = True If rngVis Is Nothing Then MsgBox sFind & " could not be found." Else For Each VisCell In rngVis.Cells tvd = VisCell.Worksheet.Cells(VisCell.Row, "B").Text vs = VisCell.Worksheet.Cells(VisCell.Row, "C").Text MsgBox "TVD: " & tvd & vbNewLine & "VS: " & vs lastRow = rpt.Cells(rpt.Rows.Count, "A").End(xlUp).Row 'dropping it in columns A and B. Change as necessary rpt.Cells(lastRow + 1, 1) = tvd rpt.Cells(lastRow + 1, 2) = vs Next VisCell End If End Sub