Я проверил кучу разных сообщений и не могу найти точный код, который я ищу. Кроме того, я никогда не использовал VBA раньше, поэтому я пытаюсь взять коды из других сообщений и ввести свою информацию для ее работы. Пока не повезло. На работе у нас есть система начисления заработной платы в Excel. Я пытаюсь найти мое имя "Clarke, Matthew"
, а затем скопировать эту строку и вставить ее в книгу, которую я сохранил на своем рабочем столе "Total hours"
.
Как скопировать строку в excel с использованием определенного слова и вставить в другой лист Excel?
Ответ 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
СНАПШОТ
Ответ 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
Как вы можете видеть, я помещаю заполнители для конкретной настройки вашей книги.
Ответ 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