kann mir jemand vielleicht helfen die folgenden beiden Formeln zusammen zuführen, wenn ich sie ausführen will kommt en kopmpifehler einzeln laufen die formeln super.
Dim iRow As Integer
iRow = Worksheets("Dateneingabe").Cells(Rows.Count, 1).End(xlUp).Row 'Ermittelt die Einträge
If Not Intersect(Target, Range("H5:H5005" & iRow)) Is Nothing Then
If Target.Value "X" Then Exit Sub
With Worksheets("Urkunde")
.Select
.Cells(2, 1).Value = Cells(Target.Row, 2) & Space(1) & Cells(Target.Row, 3).Value '
.Cells(4, 1).Value = Cells(Target.Row, 6)
.Cells(6, 5).Value = Cells(Target.Row, 7)
.Cells(8, 1).Value = Space(4) & Date & ", Ort"
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Worksheets("Dateneingabe").Select
End If
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim merker As Long
Dim aktRow As Long
Dim anfang As Long
anfang = 5
With ActiveSheet
merker = 1
For aktRow = anfang To .UsedRange.SpecialCells(xlCellTypeLastCell).Row
If Target.Column > 1 Then
.Cells(aktRow, 1) = merker
merker = merker + 1
End If
Next
End With
End Sub
Danke und GRuß
Daniel