AW: Text in mehreren Worksheets suchen und kopieren
15.03.2006 14:36:49
Oliver
Hallo Heiko,
vielen Dank für die schnelle Antwort.
Ich kriegs leider nicht hin.
Könntest Du Dir mal den Code anschauen ? Was ist Falsch ?
Er soll in den 12 Sheets in der 3. Spalte nach einem text suchen und die gefundenen Zeilen in "Liste" kopieren.
Für das einmalige Suchen in nur einem Sheet habe ich bereits folgenden Code:
Sub wert_kopieren()
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim wert As String, rFind As Range
Dim lrow As Long, i As Long
Dim sFirst As String
Set wks1 = ActiveSheet
Set wks2 = Sheets("Liste")
lrow = wks2.Range("A65536").End(xlUp).Row + 1
wert = Application.InputBox("Wert für die Suche eingeben!", "Suche", "")
Set rFind = wks1.Range("c:c").Find(what:=wert, LookIn:=xlValues, lookat:=xlWhole)
If Not rFind Is Nothing Then
sFirst = rFind.Address
Do
rFind.EntireRow.Copy wks2.Cells(lrow, 1)
Set rFind = wks1.Range("c:c").FindNext(rFind)
lrow = lrow + 1
Loop While sFirst <> rFind.Address
End If
sFirst = vbNullString
Set rFind = Nothing
End Sub
Habe versucht Deinen Code mit meinem zu verbinden, es kommt aber nichts:
Sub AlleSheetsDurch()
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim wert As String, rFind As Range
Dim lrow As Long, i As Long
Dim sFirst As String
Set wks2 = Sheets("Liste")
wert = Application.InputBox("Wert für die Suche eingeben!", "Suche", "")
For Each wks1 In ActiveWorkbook.Worksheets
If wks1.Name <> "Liste" Then
lrow = wks2.Range("A65536").End(xlUp).Row + 1
'wert = Application.InputBox("Wert für die Suche eingeben!", "Suche", "")
Set rFind = wks1.Range("c:c").Find(what:=wert, LookIn:=xlValues, lookat:=xlWhole)
If Not rFind Is Nothing Then
sFirst = rFind.Address
Do
rFind.EntireRow.Copy wks2.Cells(lrow, 1)
Set rFind = wks1.Range("c:c").FindNext(rFind)
lrow = lrow + 1
Loop While sFirst <> rFind.Address
End If
sFirst = vbNullString
Set rFind = Nothing
End If
Next wks1
End Sub
Vielen Dank
Tschüß Olli