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

Question

我检查了一堆不同的帖子,似乎无法找到我正在寻找的确切代码.此外,我之前从未使用过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.Close
End Sub

快照

Answer 2

扩展 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 

正如您所看到的，我为您的工作簿的特定设置添加了占位符。