Makro soll in die nächste Zelle springen
10.01.2021 14:10:06
Mildred
ich habe einen VBA Code, das bei der Eingabe in bestimmten Zellen ein anderes Tabellenblatt kopiert und mit dem Namen des jeweiligen Zellinhaltes anlegt. Gleichzeitig wird aber auch geprüft, ob dieser Name bereits existiert, weil ja nicht 2 Tabellenblätter mit dem gleichen Namen in einer Datei angelegt werden können. Wenn dies der Fall ist, wird das Tabellenblatt nicht kopiert und nicht mit den Namen angelegt. Jetzt möchte ich das Makro aber so steuern, dass, wenn in diesen Zellen ein Name eingetragen wird, der bereits existiert, der Cursor in die nächste Zelle springt, ohne den Eintrag in der jeweiligen Zelle zu erlauben. Das Makro darf aber nicht so gesteuert werden, dass dann in der besagten Zelle der Inhalt auf leer ("") gesetzt wird, weil es auch hier ein weiteres Makro gibt, dass, wenn die Zelle geleert wird, ein Tabellenblatt gelöscht wird. Das Makro muss in die nächste Zelle springen.
Das Makro sieht so aus (es geht um den Teil, der fett und kursiv geschrieben ist):
Option Explicit
Private mstrSheetname As String
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Fehler As Integer, ws As Object
If Target.Column = 5 Then
Select Case Target.Row
Case 12, 18, 24, 30
If Not IsEmpty(Target.Cells(1, 1).Value) Then
mstrSheetname = Replace(Target.Cells(1, 1), "/", "")
If MsgBox("Tabelenblatt mit Name """ & Target.Text & """ anlegen ?", _
vbYesNo, "Blatt Vorlage kopieren") = vbYes Then
For Each ws In ThisWorkbook.Worksheets
If ws.Name = mstrSheetname Then
MsgBox "Blatt mit dem eingegeben Namen " & mstrSheetname _
& " existiert bereits!"
Target.Select
Exit Sub
End If
Next
Application.ScreenUpdating = False
With Worksheets("Kalkulationsvorlage")
.Visible = xlSheetVisible
.Copy Before:=Worksheets("Kalkulationsvorlage")
.Visible = xlSheetVeryHidden
End With
ActiveSheet.Name = mstrSheetname
End If
Else
For Each ws In ThisWorkbook.Worksheets
If ws.Name = mstrSheetname Then
If MsgBox("Tabellenblatt wirklich löschen?", vbYesNo) = vbYes Then
Application.DisplayAlerts = False
ws.Delete
End If
Exit For
End If
Next ws
End If
Case Else
End Select
End If
Worksheets("Deckblatt Pos 1-4").Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 5 Then
Select Case Target.Row
Case 12, 18, 24, 30
mstrSheetname = Replace(Target.Cells(1, 1), "/", "")
Case Else
End Select
End If
End Sub
Vielen Dank im Voraus für eure Hilfe.
V.G. Mildred
Anzeige