Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
492to496
492to496
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Zeile kopieren mit zwei Bedingungen

Zeile kopieren mit zwei Bedingungen
05.10.2004 18:29:45
Wolfi
Hallo Zusammen,
hab mal wieder ein kleines Problem:
Ich durchsuche eine Spalte nach einem Wert, wenn dieser vorhanden soll die ganze Zeile in ein anderes Tabellenblatt kopiert werden.
Geht auch ohne Probleme mit dem untenstehenden Code.
Aber nur mit einer Bedingung. Ich möchte das aber mit zwei Bedingungen etwa so:
If rw.Cells(8).Value = "PPManufacturingSolution" Or "SAP Arbeitsplan "Then und das klappt nicht. Wie muss ich den Code anpassen.
Gruß und Danke Wolfi
Sub SuchenUndKopieren() Dim wksQ As Worksheet 'Quell-Tabelle Dim wksZ As Worksheet 'Ziel-Tabelle Dim rng As Range Dim lngQ As Long Dim lngz As Long Set wksQ = Sheets("SAP_Export") Set wksZ = Sheets("SAP_Export_2") lngQ = wksQ.Range("H65536").End(xlUp).Row lngz = wksZ.Range("A65536").End(xlUp).Row + 1 For Each rw In wksQ.Rows If rw.Cells(8).Value = "PPManufacturingSolution" Then rw.EntireRow.Copy wksZ.Cells(lngz, 1) lngz = lngz + 1 End If Next End Sub

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeile kopieren mit zwei Bedingungen
Kay
Hallo Wolfi
If rw.Cells(8).Value = "PPManufacturingSolution" Or rw.Cells(8).Value ="SAP Arbeitsplan "Then
Versuche es mal so.
Gruß Kay
AW: Zeile kopieren mit zwei Bedingungen
Reinhard
Hi Wolfi,
ungetestet:
If rw.Cells(8).Value = "PPManufacturingSolution" Or rw.Cells(8).Value = "SAP Arbeitsplan "Then
Gruß
Reinhard
AW: Zeile kopieren mit zwei Bedingungen
Wolfi
Hallo Reinhard,
Vielen Dank das war es jetzt funzt es
Gruß Wolfi und ein schönen Abend
AW: Zeile kopieren mit zwei Bedingungen
Kay
Hi,
hätte da noch eine andere Variante mit der Case Anweisung.
Finde ich persönlich übersichtlicher, nur mal so:
Sub SuchenUndKopieren()
<span style="color:#000080"; >Dim</span> wksQ <span style="color:#000080"; >As</span> Worksheet   <span style="color:#008000"; >'Quell-Tabelle</span>
<span style="color:#000080"; >Dim</span> wksZ <span style="color:#000080"; >As</span> Worksheet   <span style="color:#008000"; >'Ziel-Tabelle</span>
<span style="color:#000080"; >Dim</span> rng <span style="color:#000080"; >As</span> Range
<span style="color:#000080"; >Dim</span> lngQ <span style="color:#000080"; >As</span> <span style="color:#000080"; >Long</span>
<span style="color:#000080"; >Dim</span> lngz <span style="color:#000080"; >As</span> <span style="color:#000080"; >Long</span>
<span style="color:#000080"; >Set</span> wksQ = Sheets(<span style="color:#800000"; >"Tabelle1"</span>)
<span style="color:#000080"; >Set</span> wksZ = Sheets(<span style="color:#800000"; >"Tabelle2"</span>)
lngQ = wksQ.Range(<span style="color:#800000"; >"H65536"</span>).End(xlUp).Row
lngz = wksZ.Range(<span style="color:#800000"; >"A65536"</span>).End(xlUp).Row + 1
<span style="color:#000080"; >For</span> Each rw In wksQ.Rows
<span style="color:#000080"; >Select</span> <span style="color:#000080"; >Case</span> rw.Cells(8)
<span style="color:#000080"; >Case</span> <span style="color:#800000"; >"eins"</span>, <span style="color:#800000"; >"zwei"</span>
rw.EntireRow.Copy wksZ.Cells(lngz, 1)
<span style="color:#000080"; >End</span> <span style="color:#000080"; >Select</span>
lngz = lngz + 1
<span style="color:#000080"; >Next</span>
<b><span style="color:#000080"; >End</span> <span style="color:#000080"; >Sub</span></b>


Gruß
Kay
Anzeige
AW: da is was schief gegangen
Kay
hier nochmal:

Sub SuchenUndKopieren()
Dim wksQ As Worksheet   'Quell-Tabelle
Dim wksZ As Worksheet   'Ziel-Tabelle
Dim rng As Range
Dim lngQ As Long
Dim lngz As Long
Set wksQ = Sheets("Tabelle1")  ' musst du noch Anpassen
Set wksZ = Sheets("Tabelle2")  ' musst du noch Anpassen
lngQ = wksQ.Range("H65536").End(xlUp).Row
lngz = wksZ.Range("A65536").End(xlUp).Row + 1
For Each rw In wksQ.Rows
Select Case rw.Cells(8)
Case "eins", "zwei"                    ' musst du noch Anpassen
rw.EntireRow.Copy wksZ.Cells(lngz, 1)
End Select
lngz = lngz + 1
Next
End Sub

Kay
Anzeige
AW: da is was schief gegangen
Wolfi
Hallo Kay,
hab die erste Lösung genommen und eingefügt, ist weniger Code.
Vielen Dank
Gruß Wolfi und ein schönen Abend

359 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige