TA貢獻(xiàn)1789條經(jīng)驗(yàn) 獲得超8個(gè)贊
試測(cè)試
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
TA貢獻(xiàn)1982條經(jīng)驗(yàn) 獲得超2個(gè)贊
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
TA貢獻(xiàn)1836條經(jīng)驗(yàn) 獲得超3個(gè)贊
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舉報(bào)