Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
376to380
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
376to380
376to380
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Zeilen nach bestimmten Kriterien in neues Blatt

Zeilen nach bestimmten Kriterien in neues Blatt
06.02.2004 11:00:21
Hannelore D.
Hallo an alle VBA - Profis!!
Ich versuche ein Makro zu schreiben das mir Zeilen die einen bestimmten Textteil enthalten in eine neues Arbeitsblatt kopiert.
Leider habe ich überhaupt keine Idee wie ich nur nach Textteilen in Zellen suchen kann . Wobei der Text immer an verschiedenen Positionen stehen kann.
Der Text steht in der Ursprungsdatei immer in Spalte D.
Aus dieser Datei sollen dann drei neue Arbeistblätter entstehen.
1. Ausfall sonst. (soll alle Zeilen enthalten die in der Spalte D den Textteil "Ausfallzeit sonst." enthalten.)
2. Ausfall Weiter. (soll alle Zeilen enthalten die in der Spalte D den Textteil "Ausfallzeit Weiterb." enthalten.)
3. Produktiv (soll alle Zeilen enthalten die in der Spalte D weder den Textteil "Ausfallzeit sonst." noch "Ausfallzeit Weiterb." enthält.)
Kann mir da jemand weiterhelfen?? Es würde mir die Arbeit erheblich erleichtern und mit meinen Mini-VBA Kenntnissen bekomme ich das nicht hin!
Vielen Dank im Voraus!

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Guck mal jetzt hier
06.02.2004 11:52:22
y
hi Hannelore,
so in etwa ?

Private Sub kopieren()
Dim i As Integer
Dim x As Integer
i = 1
x = 1
Do While Cells(i, 4) <> ""
If InStr(Cells(i, 4), "Ausfallzeit sonst.") <> 0 Then
Rows(i).Copy Destination:=Worksheets("Ausfallzeit sonst.").Rows(x): x = x + 1
End If
If InStr(Cells(i, 4), "Ausfallzeit Weiterb.") <> 0 Then
Rows(i).Copy Destination:=Worksheets("Ausfallzeit Weiterb.").Rows(x): x = x + 1
End If
If InStr(Cells(i, 4), "Ausfallzeit sonst.") <> 0 Then
Rows(i).Copy Destination:=Worksheets("Ausfallzeit sonst.").Rows(x): x = x + 1
End If
i = i + 1
Loop
End Sub

ci Micha
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige