Jak skopiować linię w programie Excel za pomocą określonego słowa i wkleić do innego arkusza programu Excel?

Question

Sprawdziłem kilka różnych postów i nie mogę znaleźć dokładnego kodu, którego szukam. Również nigdy wcześniej nie używałam VBA, więc próbuję zabrać kody z innych postów i wprowadzić moje informacje, aby działały. Bez szczęścia. W pracy mamy system płac w Excel. Próbuję wyszukać moje imię i nazwisko "Clarke, Matthew", a następnie skopiuj ten wiersz i wklej go do skoroszytu zapisanego na moim komputerze "Total hours".

Answer 1

Po rozwinięciu tego, co timrau powiedział w swoim komentarzu, możesz użyć funkcji AutoFilter, aby znaleźć wiersz z Twoim imieniem i nazwiskiem. (Zauważ, że jestem zakładając, że masz skoroszyt open source)

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 

Jak widać umieścić w zastępcze dla konkretnej konfiguracji skoroszycie.

Answer 2

SPRAWDZONA

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 

SNAPSHOT

Answer 3

wiem, że to jest stary, ale dla nikogo szukasz jak to zrobić, można to zrobić w znacznie bardziej bezpośrednia moda:

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