Wenn ungleich leer, dann Werte übertragen
21.01.2019 11:32:36
Christian
es geht im folgenden Quelltext um die schwarz markierte Zeile. Mit der Funktion übertrage ich alle Daten die das Kriterium in Zelle C2 erfüllt.
Ich möchte jedoch nur die Werte übertragen, welche in der Spalte W in der Zielquelle ungleich leer sind. Die Spalte W habe ich überprüft und alle Werte mit Hilfe einer Formel "leer" gemacht. Jetzt sind nur noch die Werte vorhanden, die ich auch übertragen möchte. Dennoch überträgt er mir auch alle leeren.
Wo könnte mein Fehler liegen?
Sub KopiereDaten3()
Dim wsZiel As Worksheet
Dim lngLZeileQuelle As Long
Dim lngLZeileZiel As Long
Dim lngAktZeile As Long
Dim wsQuelleShip As Worksheet
Set wsQuelleShip = tabShipset 'Ziel_Data_Comp
Set wsZiel = TabWO 'WO Monitor
lngLZeileQuelle = wsQuelleShip.Cells.Find("*", wsQuelleShip.Range("A1"), xlFormulas, xlWhole, _
xlByRows, xlPrevious).Row
lngLZeileZiel = wsZiel.Cells.Find("*", wsZiel.Range("A1"), xlFormulas, xlWhole, xlByRows, _
xlPrevious).Row
wsQuelleShip.Range("A1").AutoFilter Field:=Columns("A").Column, Criteria1:=Range("C2")
wsZiel.Range("B11:H" & lngLZeileQuelle).Clear
If wsQuelleShip.Range("W" & lngLZeileQuelle).Value "" Then
wsQuelleShip.Range("E2:E" & lngLZeileQuelle).Copy wsZiel.Range("B11")
wsQuelleShip.Range("W2:W" & lngLZeileQuelle).Copy wsZiel.Range("C11")
End If
End Sub