bitte helft mir. Ich habe untenstehendes Makro, welches wie ihr seht im Sub Spalte E Werte einfügt.
Gibt es eine Möglichkeit, bei den Spalten C, J und K zu unterscheiden ob der einzufügende Wert eine Zahl größer als oder eine Zahl kleiner gleich 0 ist?
Wäre super, wenn das Makro bei Zahlen größer 0 diese im Zellformat Datum TT.MM.JJJJ einfügt und bei Zahlen kleiner 0 als Zahl ohne Nachkommastellen.
Könnt ihr mir dabei behilflich sein, das Makro abzuändern?
Danke
Jenny
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TC As Long
Dim c As Range
Application.ScreenUpdating = False
If Target.Columns.Count > 1 Then Exit Sub
If Target.Column = 5 Or Target.Column = 7 Then TC = Target.Column Else Exit Sub
'If Target.Count = 1 And Target "" Then
On Error GoTo ERREXIT
Application.EnableEvents = False
Select Case TC
Case 5: For Each c In Target
If c "" Then Call SpalteE(c)
Next
Case 7: For Each c In Target
If c "" Then
Call SpalteG(c)
Call SpalteE(c)
End If
Next
End Select
ERREXIT:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub SpalteG(ByVal Target As Range)
Dim r As Range, c As Range, z&, cc As Range, zf&
Dim gefunden As Boolean
If Target.Offset(, -6) "" Then
z = Target.Row
gefunden = False
Set cc = Range("A1:A" & z - 1).Find(Target.Offset(, -6).Value, _
Range("A1"), xlValues, xlWhole)
If Not cc Is Nothing Then
zf = cc.Row
Do
Set cc = Range("A1:A" & z - 1).FindNext(cc)
If cc.Offset(, 6) = Target Then
Target.Offset(, -2) = cc.Offset(, 4) '& " " & (cc.Offset(, 4).Address)
gefunden = True
End If
Loop Until cc Is Nothing Or cc.Row = zf Or gefunden
End If
If Not gefunden Then Target.Offset(, -2).Value = "n.v."
End If
End Sub
Sub SpalteE(ByVal Target As Range)
Dim lngR As Long
lngR = Target.Row
Cells(lngR, 2).FormulaR1C1 = Cells(1, 2).FormulaR1C1
Cells(lngR, 3).FormulaR1C1 = Cells(1, 3).FormulaR1C1
Cells(lngR, 6).FormulaR1C1 = Cells(1, 6).FormulaR1C1
Cells(lngR, 8).FormulaR1C1 = Cells(1, 8).FormulaR1C1
Cells(lngR, 9).FormulaR1C1 = Cells(1, 9).FormulaR1C1
Cells(lngR, 10).FormulaR1C1 = Cells(1, 10).FormulaR1C1
Cells(lngR, 11).FormulaR1C1 = Cells(1, 11).FormulaR1C1
Cells(lngR, 12).FormulaR1C1 = Cells(1, 12).FormulaR1C1
Rows(lngR).Copy
Cells(lngR, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Target.Select
End Sub