如何在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