如何使用特定的单词复制Excel中的一行并粘贴到另一个Excel工作表上？

Question

如何使用特定的单词复制Excel中的一行并粘贴到另一个Excel工作表上？我检查了一堆不同的帖子，似乎找不到我要找的确切代码。而且我从来没有用过VBA在此之前，我试图从其他帖子中获取代码，并输入我的信息以使其发挥作用。还没有运气。在工作中，我们有一个工资系统EXCEL..我在寻找我的名字"Clarke, Matthew"然后复制该行并将其粘贴到我在桌面上保存的工作簿上。"Total hours".

Answer 1

试测试

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.CloseEnd Sub

Answer 2

扩展timrau在他的评论中所说的内容，您可以使用autofilter函数查找包含您名字的行。(请注意，我假设您打开了源代码工作簿)

Dim curBook As WorkbookDim targetBook As WorkbookDim curSheet As WorksheetDim targetSheet As WorksheetDim lastRow As IntegerSet 
curBook = ActiveWorkbookSet curSheet = curBook.Worksheets("yourSheetName")'change the Field number to the correct columncurSheet.
Cells.AutoFilter Field:=1, Criteria1:="Clarke, Matthew" 'The Offset is to remove the header row from the copycurSheet.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 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 WithEnd Sub