Hallo M.O.
ich habe die Frage wiederholt.
Eine Excel Quell Tabelle 1 wird mittels VBA Code Markierung ( „X“ in Spalte „ E „ ) in eine Ziel Excel Tabelle 2 ohne Lücken untereinander kopiert.
In den Zellen von Tabelle 1 = ( Spalte „ D „ ) ist eine Summenberechnung mittels Formel hinterlegt. Format dieser Spalte „ D „ ist Währung.
Diese kopierten Zellen werden in der Ziel Excel Tabelle 2 automatisch angelegt, wobei in der Spalte „ D „ der Wert in den einzelnen Zellen falsch wiedergegeben wird. (falsche Formel und mit den falschen Zellwerten ).
Die Spalte „ A „ der Quell Excel Tabelle 1 ist eine eindeutige Zuordnung und wiederholt sich nicht.
Meine Frage:
Wie ist dies zu realisieren, dass die Zellinhalte in der Spalte „ D „ in der Ziel Excel Tabelle 2 richtig wiedergegeben werden?
Gruß Berpre
[code]
Quellcode in der Quell Excel Tabelle 1:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'im Klassenmodul des Blattes "Daten"
Dim rngVeränderung As Range
Dim wsQuelle As Worksheet
Dim wsZiel As Worksheet
Dim rngSuche As Range
Set wsQuelle = Worksheets("Daten")
Set wsZiel = Worksheets("Beschläge")
If Not Intersect(Target, Columns("E")) Is Nothing Then
For Each rngVeränderung In Intersect(Target, Columns("E"))
If UCase(rngVeränderung) = "X" Then 'Wenn ein "X" gesetzt wurde
'Prüfen, ob Wert in Zieltabelle vorhanden
With wsZiel
Set rngSuche = .Columns("A").Find(wsQuelle.Cells(rngVeränderung.Row, 1), lookat:=xlWhole)
End With
If rngSuche Is Nothing Then 'Wenn Wert aus Spalte A nicht gefunden wurde...
With wsQuelle
.Cells(rngVeränderung.Row, "A").Resize(, 4).Copy _
Destination:=wsZiel.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
Else 'Datensatz existiert bereits
MsgBox "Der Datensatz " & wsQuelle.Cells(rngVeränderung.Row, 1) & " existiert bereits!"
End If
ElseIf IsEmpty(rngVeränderung) Then 'Wenn das "X" gelöscht wurde bzw. die Zelle leer ist
'Prüfen, ob Wert in Zieltabelle vorhanden ist
With wsZiel
Set rngSuche = .Columns("A").Find(wsQuelle.Cells(rngVeränderung.Row, 1), lookat:=xlWhole)
End With
If Not rngSuche Is Nothing Then 'Wert gefunden
rngSuche.EntireRow.Delete
End If
End If
Next rngVeränderung
End If
Set rngSuche = Nothing
Set wsZiel = Nothing
Set wsQuelle = Nothing
End Sub
[*]
[sup]
*Threadedit* 28.08.2010, 20:47:25
Admininfo: Führe Threads bitte nicht fort, indem du weitere eröffnest, und vermeide Mehrfachanfragen! Die Datenbank und User werden es dir danken. Siehe FAQ 2, #3.[/sup]