Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
744to748
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
744to748
744to748
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Text in mehreren Worksheets suchen und kopieren

Text in mehreren Worksheets suchen und kopieren
15.03.2006 12:34:06
Oliver
Hallo,
bin neu hier, habe aber schon oft reingeschaut.
Habe bis jetzt alles gefunden, außer meine folgende Frage.
Ich habe eine Datei mit einem Ergebnissheet und 12 Monatssheets.
Ich möchte nach einem Zellinhalt in den 12 Monatssheets in der jeweils 2. Spalte suchen und die gefundenen Zeilen in das Ergebnissheet kopieren.
Aus einem Sheet kann ich alle Zeilen kopieren.
Mir fehlt nur noch der Syntax zum durchlaufen der 12 Monatssheets.
Kann mir jemand helfen. Diese Schleife ist bestimmt nicht schwer.
Vielen Dank für Eure Hilfe.

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Text in mehreren Worksheets suchen und kopieren
15.03.2006 13:31:41
Heiko
Hallo Oliver,
z.B. so :

Sub AlleSheetsDurch()
Dim wksSheets As Worksheet
For Each wksSheets In ActiveWorkbook.Worksheets
' Hier für StartTabelle den Namen deiner Tabelle eintragen, in die die Daten
' aus den anderen Tabellen hineinkopiert werden sollen.
If wksSheets.Name <> "StartTabelle" Then
MsgBox wksSheets.Name
' wksSheets.Range("A1.B5").Copy Destination:=Workssheets("StartTabelle").Range("A1")
End If
Next wksSheets
End Sub

Gruß Heiko
PS: Rückmeldung wäre nett !
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
Anzeige
AW: Text in mehreren Worksheets suchen und kopieren
15.03.2006 15:00:56
Heiko
Hallo Oliver,
versuche es mal so, bei klappt das mit einer einfachen Tabelle.

Sub wert_kopieren()
Dim wks1 As Worksheet, wks2 As Worksheet
Dim wert As String, sFirst As String
Dim rFind As Range
Dim lrow As Long, i As Long
Set wks2 = Sheets("Liste")
wert = Application.InputBox("Wert für die Suche eingeben!", "Suche", "")
lrow = wks2.Range("A65536").End(xlUp).Row + 1
For Each wks1 In ActiveWorkbook.Worksheets
If wks1.Name <> "Liste" Then
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)
lrow = lrow + 1
Set rFind = wks1.Range("c:c").FindNext(rFind)
Loop While sFirst <> rFind.Address
End If
sFirst = vbNullString
Set rFind = Nothing
End If
Next wks1
End Sub

Gruß Heiko
PS: Rückmeldung wäre nett !
Anzeige
AW: Text in mehreren Worksheets suchen und kopieren
15.03.2006 15:22:39
Oliver
Hallo Heiko,
das klappt super.
Damit hab ich ein perfektes Instrument zum Filtern von meinen großen Monatsdateien.
Mit mir freut sich unsere QT.
Vielen Dank,
Tschüß Olli

315 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige