ich habe es gestern hinbekommen, dass mein Makro ein neues Tabellenblatt erstellt, es so formatiert wie ich es möchte und Werte einfügt wie ich es möchte.
Falls man noch weitere Eingaben vornehmen will, wollte ich das ganze mit worksheet change automatisieren damit man nicht wirklich jede Zelle selbst ausfüllen muss. Ich habe den WorksheetChange Code auf einem Mustertabellenblatt erstellt und dort funktioniert er einwandfrei, wenn aber der Code auf das neue Tabellenblatt kopiert wird funktioniert nur ein Teil.
So sieht der Code aus:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
Dim sp%, Einheit$
Dim i As Variant
Dim loLetzte As Long
sp = 4 ' Spalte D Gegenstand
' Gegenstand Menge Position
loLetzte = Sheets("BMDS").Cells(Rows.Count, 4).End(xlUp).Row
If Target.Row > loLetzte Then
If Not Intersect(Columns(sp), Target) Is Nothing And Target = "" Then
Target.EntireRow.clear
End If
If Not Intersect(Columns(sp), Target) Is Nothing And Target "" Then
If Target.Count = 1 Then
Range(Target.Offset(0, -3), Target.Offset(0, -1)).clear
Range(Target.Offset(0, 1), Target.Offset(0, 8)).clear
Target.Interior.Color = xlNone
Select Case Target.Value
Case "Gewindebolzen" '...
Einheit = "St"
Target.Offset(0, 3) = "'-"
Target.Offset(0, 11) = "'-"
Case "Muttern"
Einheit = "St"
Target.Offset(0, 2) = "'-"
Target.Offset(0, 3) = "'-"
Target.Offset(0, 11) = "'-"
'case Weitere
'Einheit = "me"
Case Else
MsgBox Target & ": noch nicht zugeordnet"
End Select
Target.Offset(0, -1) = Einheit
End If
End If
End If
Fehler:
' If Err.Number 0 Then MsgBox "Fehler: " & _
' Err.Number & vbLf & Err.Description: Err.clear
Application.EnableEvents = True
End Sub
und nur der Teil funktioniert:
If Not Intersect(Columns(sp), Target) Is Nothing And Target = "" Then
Target.EntireRow.clear
End If
Also: der nimmt keine Eingabe zur Kenntnis, aber wenn ich mit Entfernen die Eingabe lösche löscht er den Inhalt in der gesamten Zeile.
Wieso führt er nicht den Rest auch aus bzw. wieso funktioniert es nicht andersrum?
Ich bin da echt überfragt und hoffe auf eure Hilfe! :)
Lieben Gruß,
Nermin