2012-07-24 14 views
11

Ich habe eine Reihe von verschiedenen Posts überprüft und finde nicht den genauen Code, nach dem ich suche. Ich habe auch nie zuvor VBA verwendet, also versuche ich, Codes von anderen Posts zu nehmen und meine Info einzugeben, damit es funktioniert. Noch kein Glück. Bei der Arbeit haben wir ein Gehaltsabrechnungssystem in Excel. Ich versuche, nach meinem Namen zu suchen "Clarke, Matthew" und dann kopieren Sie diese Zeile und fügen Sie sie in die Arbeitsmappe, die ich auf meinem Desktop "Total hours" gespeichert habe.Wie kopiert man eine Zeile in Excel mit einem bestimmten Wort und Einfügen in ein anderes Excel-Blatt?

+3

Wenn Sie nach dem Schlüsselwort in einer einzelnen Spalte suchen (z. B. alle "Clarke, Matthew" in Spalte A), sollte die Filterfunktion von Excel funktionieren. – timrau

+2

Vielleicht posten Sie, was Sie für so haben, würde uns einen besseren Ort geben, um zu helfen. Sie können auch in die Funktion 'SVERWEIS' schauen. –

+0

Sehen Sie diese http://stackoverflow.com/questions/10319096/error-when-i-use-specialcells-of-autofilter-to-get-visible-cells-in-vba/10319230#10319230 ändern Sie es an Ihre Bedürfnisse anzupassen :) –

Antwort

2

Erweitern auf was Timrau in seinem Kommentar sagte, können Sie die AutoFilter-Funktion verwenden, um die Zeile mit Ihrem Namen darin zu finden. (Beachten Sie, dass ich nehme an, Sie die Quellarbeitsmappe geöffnet haben)

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 

Wie Sie mir Ihre Arbeitsmappe setze Platzhalter in für die jeweilige Einrichtung sehen.

+0

'ActiveSheet.AutoFilter.Range.Offset (1) .Copy' Dies ist ein falscher Weg, es zu tun :) Bitte beachten Sie die zwei Links, die ich in den Kommentar gepostet. –

+0

@ Siddharth Ich habe festgestellt, dass die 'AutoFilter.Range' funktioniert gut. 'SpecialCells (xlCellTypeVisible)' sollte auch funktionieren, aber ich hatte Probleme mit der Rückgabe von leeren Zellen. –

18

BEWÄHRTEN

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 

SCHNAPPSCHUSS

enter image description here

+0

+1 Theres eine Menge Rand Fällen hier ging ich nicht in –

+0

TY für alle Feed-Back. Ich versuche, dieses zweite Makro zu verwenden, aber erhalte jetzt eine Fehlermeldung in dieser Zeile. AutoFilter Field: = 1, Criteria1: = "= *" & strSearch & "*" .... Sagt mir 'Laufzeitfehler 1004: Autofilter-Methode der Reichweite fehlgeschlagen '. Irgendwelche Vorschläge? – user1548751

+0

Was hast du hier eingestellt? 'Mit .Range (" A1: A "& lRow) '? –

1

Ich weiß, das ist alt, aber für jemand anderen suchen, wie dies zu tun, kann es in getan werden eine viel direktere Art und Weise:

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 
Verwandte Themen