VBA Zelle mit Formel überschrieben
08.01.2021 15:14:45
Marko
der Wert in dem Sheet "Tabelle3" in der Zelle "C19" wird mit diesem Makro automatisch berechnet. Nun möchte ich diesen Wert in Zelle "C19" -manuell - ändern und überschreiben. In einem weiteren Makro (über Command Button) übertrage ich diesen Wert aus Zelle "C19" in eine weiteres Sheet. Nachdem ich den Button betätigt habe, ändert sich der Wert in Zelle "C19" wieder in den durch die Formel errechneten Wert und wird übertragen. Wie bekomme ich es es hin, diesen -manuell- eingetragenen Wert zu übertragen?
Vielen Dank für Eure Unterstützung.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim oBlatt As Worksheet
Set oBlatt = ThisWorkbook.Worksheets("Tabelle3")
With oBlatt
.Range("c19").FormulaLocal = "=WENN(c14>c16;c14;c16)"
End With
Set oBlatt = Nothing
End Sub
Private Sub CommandButton1_Click()
Application.Run "FormelnSchreiben1"
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Dim raBereich As Range
Dim KndProd As Variant
Dim WerteTab4 As Variant
Dim zeile As Long, zeiTab As Long
With Worksheets("Tabelle3")
Set raBereich = Union(.Range("C5"), .Range("C11"), .Range("C19"))
KndProd = .Range("C5").Text & " | " & .Range("C11")
With Worksheets("Tabelle4")
zeiTab = .Cells(.Rows.Count, 1).End(xlUp).Row
WerteTab4 = .Range(.Cells(2, 1), .Cells(zeiTab, 2))
zeiTab = 1
For zeile = LBound(WerteTab4) To UBound(WerteTab4)
zeiTab = zeiTab + 1
If KndProd = WerteTab4(zeile, 1) & " | " & WerteTab4(zeile, 2) Then
If MsgBox("Leistungsgruppe ist bereits vorhanden" & vbLf _
& KndProd & vbLf _
& "Daten überschreiben?", vbQuestion + vbYesNo, "Daten übertragen") = vbYes _
_
Then
raBereich.Copy
.Cells(zeiTab, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
End If
GoTo Weiter
End If
Next
raBereich.Copy
.Cells(zeiTab + 1, 1) _
.PasteSpecial Paste:=xlPasteValues, Transpose:=True
End With
Weiter:
Application.CutCopyMode = False
.Range("C5").ClearContents
.Range("C11").ClearContents
.Range("C19").ClearContents
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
Range("C5").Select
End Sub
Anzeige