Microsoft Excel

Herbers Excel/VBA-Archiv

Wenn ungleich leer, dann Werte übertragen


Betrifft: Wenn ungleich leer, dann Werte übertragen von: Christian
Geschrieben am: 21.01.2019 11:32:36

Moin alle zusammen,

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

  

Betrifft: AW: Wenn ungleich leer, dann Werte übertragen von: Werner
Geschrieben am: 21.01.2019 11:40:51

Hallo Christian,

die Zelle ist nicht leer (ist ja ne Formel drin), versuch mal so:

If Len(wsQuelleShip.Range("W" & lngLZeileQuelle)) > 0 Then
Gruß Werner


  

Betrifft: AW: Wenn ungleich leer, dann Werte übertragen von: Christian
Geschrieben am: 21.01.2019 12:31:21

Moin Werner,

vielen Dank für deine schnelle Antwort. Leider überträgt er dennoch alle Werte ungeachtet von Len. Und es macht kein Unterschied ob ich If Len(wsQuelleShip.Range("W" & lngLZeileQuelle)) <> "" Then oder If Len(wsQuelleShip.Range("W" & lngLZeileQuelle)) > 0 Then verwende

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 Len(wsQuelleShip.Range("W" & lngLZeileQuelle)) <> "" Then

wsQuelleShip.Range("E2:E" & lngLZeileQuelle).Copy wsZiel.Range("B11")
wsQuelleShip.Range("W2:W" & lngLZeileQuelle).Copy wsZiel.Range("C11")

End If

End Sub
Beste Grüße
Christian


  

Betrifft: AW: Wenn ungleich leer, dann Werte übertragen von: Werner
Geschrieben am: 21.01.2019 19:44:04

Hallo Christian,

na ja, bei mir gehts und deine Datei kenne ich nicht.
Lad mal deine Mappe hoch.

Gruß Werner


Beiträge aus dem Excel-Forum zum Thema "Wenn ungleich leer, dann Werte übertragen"