如何在excel中使用特定单词复制一行并粘贴到另一个excel表单中？

Question

我检查了一堆不同的帖子，似乎无法找到我正在寻找的确切代码。此外，我从来没有使用过VBA，所以我试图从其他帖子的代码，并输入我的信息，它的工作。没有运气。在工作中，我们有一个工资系统Excel。我试图搜索我的名字"Clarke, Matthew"，然后复制该行并将其粘贴到我保存在我的桌面"Total hours"上的工作簿中。

Answer 1

在他的评论中展开timrau的说法，您可以使用AutoFilter函数来查找包含您名字的行。 （请注意，我假设你有源工作簿打开）

Dim curBook As Workbook 
Dim targetBook As Workbook 
Dim curSheet As Worksheet 
Dim targetSheet As Worksheet 
Dim lastRow As Integer 

Set curBook = ActiveWorkbook 
Set curSheet = curBook.Worksheets("yourSheetName") 

'change the Field number to the correct column 
curSheet.Cells.AutoFilter Field:=1, Criteria1:="Clarke, Matthew" 

'The Offset is to remove the header row from the copy 
curSheet.AutoFilter.Range.Offset(1).Copy 
curSheet.ShowAllData 

Set targetBook = Application.Workbooks.Open "PathTo Total Hours" 
Set targetSheet = targetBook.WorkSheet("DestinationSheet") 

lastRow = Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row 

targetSheet.Cells(lastRow + 1, 1).PasteSpecial 

targetBook.Save 
targetBook.Close 

正如你可以看到我把占位符为您的工作簿的具体设置。

Answer 2

久经考验

Sub Sample() 
    Dim wb1 As Workbook, wb2 As Workbook 
    Dim ws1 As Worksheet, ws2 As Worksheet 
    Dim copyFrom As Range 
    Dim lRow As Long '<~~ Not Integer. Might give you error in higher versions of excel 
    Dim strSearch As String 

    Set wb1 = ThisWorkbook 
    Set ws1 = wb1.Worksheets("yourSheetName") 

    strSearch = "Clarke, Matthew" 

    With ws1 

     '~~> Remove any filters 
     .AutoFilterMode = False 

     '~~> I am assuming that the names are in Col A 
     '~~> if not then change A below to whatever column letter 
     lRow = .Range("A" & .Rows.Count).End(xlUp).Row 

     With .Range("A1:A" & lRow) 
      .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*" 
      Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow 
     End With 

     '~~> Remove any filters 
     .AutoFilterMode = False 
    End With 

    '~~> Destination File 
    Set wb2 = Application.Workbooks.Open("C:\Sample.xlsx") 
    Set ws2 = wb2.Worksheets("Sheet1") 

    With ws2 
     If Application.WorksheetFunction.CountA(.Cells) <> 0 Then 
      lRow = .Cells.Find(What:="*", _ 
          After:=.Range("A1"), _ 
          Lookat:=xlPart, _ 
          LookIn:=xlFormulas, _ 
          SearchOrder:=xlByRows, _ 
          SearchDirection:=xlPrevious, _ 
          MatchCase:=False).Row 
     Else 
      lRow = 1 
     End If 

     copyFrom.Copy .Rows(lRow) 
    End With 

    wb2.Save 
    wb2.Close 
End Sub 

快照

Answer 3

我知道这是旧的，但对于其他人寻找如何做到这一点，就可以在做更直接的方式：

Public Sub ExportRow() 
    Dim v 
    Const KEY = "Clarke, Matthew" 
    Const WS = "Sheet1" 
    Const OUTPUT = "c:\totalhours.xlsx" 
    Const OUTPUT_WS = "Sheet1" 

    v = ThisWorkbook.Sheets(WS).Evaluate("index(a:xfd,match(""" & KEY & """,a:a,),)") 
    With Workbooks.Open(OUTPUT).Sheets(OUTPUT_WS) 
     .[1:1].Offset(.[counta(a:a)]) = v 
     .Parent.Save: .Parent.Close 
    End With 
End Sub