其实我觉得你是一个聪明人;我个人讨厌 2007/2010 的用户界面,原因有很多。
要回答您的问题,请看看这是否有意义。 (它又快又脏,所以它不是防弹的。不过,它应该给你一个起点。)
Sub FindAndCopyEmailAddress()
Dim vnt_Input As Variant
Dim rng_Found As Excel.Range
Dim wks1 As Excel.Worksheet, wks2 As Excel.Worksheet
Dim rng_target As Excel.Range
Dim l_FreeRow As Long
'Check that the sheets are there, and get a reference to
'them. Change the sheet names if they're different in yours.
On Error Resume Next
Set wks1 = ThisWorkbook.Worksheets("Sheet1")
Set wks2 = ThisWorkbook.Worksheets("Sheet2")
'If a runtime error occurs, jump to the line marked
'ErrorHandler to display the details before exiting the
'procedure.
On Error GoTo ErrorHandler
'Creating a message to tell *which* one is missing is left as an exercise
'for the reader, if you wish to.
If wks1 Is Nothing Or wks2 Is Nothing Then
Err.Raise vbObjectError + 20000, , "Cannot find sheet1 or 2"
End If
'Get the e-mail address that you want to find.
'You don't HAVE to use an InputBox; you could, for instance,
'pick it up from the contents of another cell; that's up
'to you.
vnt_Input = InputBox("Please enter the address that you're looking for", "Address Copier")
'If the user cancels the input box, exit the program.
'Do the same if there's no entry.
'Rather than exiting immediately we jump to the label
'ExitPoint so that all references are cleaned up.
'Perhaps unnecessary, but I prefer good housekeeping.
If vnt_Input = "" Then GoTo ExitPoint
'Find the range containing the e-mail address, if there is one.
'wks1.Cells essentially means "Look in all of the cells in the sheet
'that we assigned to the wks1 variable above". You don't have to be
'on that sheet to do this, you can be in any sheet of the workbook.
Set rng_Found = wks1.Cells.Find(What:=vnt_Input, After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
'The range will be Nothing if the address is not found. In that case, exit.
If rng_Found Is Nothing Then
MsgBox "Cannot find that address."
GoTo ExitPoint
End If
'Find the last free row in sheet2
'The .Row property tells us where the used range starts,
'the .Rows property tells us how many to add on to that to
'find the first free one.
'The only slight problem is that if there are no cells at
'all used in sheet 2, this will return row 2 rather than row
'1, but in practice that may not matter.
'(I wouldn't be surprised if you want headings anyway.)
l_FreeRow = wks2.UsedRange.Row + wks2.UsedRange.Rows.Count
'Make sure that the row is not greater than the number
'of rows on the sheet.
If l_FreeRow > wks2.Rows.Count Then
Err.Raise vbObjectError + 20000, , "No free rows on sheet " & wks2.Name
End If
'Set a range reference to the target.
'This will be the first free row, column 1 (column A).
Set rng_target = wks2.Cells(l_FreeRow, 1)
'Now copy the entire row that contains the e-mail address
'to the target that we identified above. Note that we DON'T need
'to select either the source range or the target range to do this; in fact
'doing so would just slow the code down.
rng_Found.EntireRow.Copy rng_target
'We always leave the procedure at this point so that we can clear
'all of the object variables (sheets, ranges, etc).
ExitPoint:
On Error Resume Next
Set rng_Found = Nothing
Set wks1 = Nothing
Set wks2 = Nothing
Set rng_target = Nothing
On Error GoTo 0
Exit Sub
ErrorHandler:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Resume ExitPoint
End Sub