AW: automatischer Übertrag von Tabelle 1 nach 2
18.04.2016 10:14:20
Tabelle
Hi Alex
Im Anhang ein Gegenvorschlag.
https://www.herber.de/bbs/user/105041.xls
Das Blatt "Best Price" aktualisiert sich mittels folgendem Makro automatisch.
Private Sub Worksheet_Activate()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim iZeile As Long, letzteZeile As Long
' Blattnamen anpassen
Set WS1 = Worksheets("Blatt2")
Set WS2 = Worksheets("Best Price")
' Prüfen ob neue Objekte vorhanden sind
For iZeile = 3 To WS1.Cells(WS1.Rows.Count, 1).End(xlUp).Row
If WorksheetFunction.CountIf(WS2.Columns(1), WS1.Cells(iZeile, 1)) = 0 Then
letzteZeile = WS2.Cells(WS2.Rows.Count, 1).End(xlUp).Row + 1
WS2.Cells(letzteZeile, 1) = WS1.Cells(iZeile, 1)
WS2.Cells(letzteZeile, 2).Formula = "=SUMIF(" & WS1.Name & "!A:A,A" & letzteZeile & "," _
& WS1.Name & "!F:F)"
WS2.Cells(letzteZeile, 3).Formula = "=SUMIF(" & WS1.Name & "!A:A,A" & letzteZeile & "," _
& WS1.Name & "!G:G)"
WS2.Cells(letzteZeile, 4).Formula = "=C" & letzteZeile & "/SUM(C:C)"
WS2.Cells(letzteZeile, 5).FormulaArray = "=MIN(IF(" & WS1.Name & "!A$3:A$1000=A" & _
letzteZeile & "," & WS1.Name & "!G$3:G$1000))"
WS2.Cells(letzteZeile, 6).FormulaArray = "=MAX(IF(" & WS1.Name & "!A$3:A$1000=A" & _
letzteZeile & "," & WS1.Name & "!G$3:G$1000))"
End If
Next iZeile
' Wegfallende Objekte löschen
For iZeile = WS2.Cells(WS2.Rows.Count, 1).End(xlUp).Row To 2 Step -1
If WorksheetFunction.CountIf(WS1.Columns(1), WS2.Cells(iZeile, 1)) = 0 Then _
WS2.Rows(iZeile).Delete
Next iZeile
End Sub
Im Blatt "Best Price" kannst du angeben, wenn du einen günstigeren Preis findest. Dieser wird dann in Blatt2 übernommen und die Zeile rot markiert.
cu
Chris