Makro ändern ?
01.10.2008 12:54:31
Walter
ich habe folgendes Makro, auch über Forum, klappt soweit.
Wenn ich in der Zelle A4 stehe, da steht der 1. Name der auch dann in die
Inputbox direkt eingelesen wird, wird die neue Tabelle erstellt.
Nun möchte ich aber nicht die Inputbox sondern es sollen alle Namen
die in der Spalte ab A4 stehen eine Tabelle erstellt werden.
Das Problem ich habe dazwischen untersschiedlich Leere Zeilen, bis zu 5 also
die sollen übersprungen werden, wenn mehr als 6 Leere Zeilen vorhanden sind, ist also das Ende
erreicht.
Kann man dies irgendwie einbauen / ändern ?
Public Sub ZV_VK_Sheet_NEU_erstellen()
Dim strNewSh As String
Dim iBlatt As Integer
Dim rng As Range
Dim bGefunden As Boolean
Set rng = ActiveCell
strNewSh = Blattname ' den neu einzufügenden Blattnamen holen
If strNewSh = Empty Then Exit Sub ' wurde kein Blattname eingegeben ?
With ThisWorkbook
For iBlatt = 1 To .Worksheets.Count
bGefunden = True
Exit For
' End If
Next iBlatt
For iBlatt = iBlatt To .Worksheets.Count
' Schlussbedingung - evtl. ändern
If .Sheets(iBlatt).Name Like "Tabelle*" Or _
.Sheets(iBlatt).Name Like "Sheet*" Then Exit For
If UCase(strNewSh)
Public Function Blattname()
Dim Question As Byte
start:
Blattname = InputBox("Name des neuen Blattes", "Eingabe", ActiveCell.Value)
If Blattname = Empty Then Exit Function
Do While ShExists(Blattname)
Question = MsgBox("Ein Blatt namens " & Blattname & " ist bereits vorhanden!" & _
vbCrLf & "Soll dieses gelöscht werden ?", vbYesNoCancel + vbQuestion)
If Question = vbYes Then
ThisWorkbook.Sheets(Blattname).Delete
ElseIf Question = vbCancel Then
Blattname = ""
ElseIf Question = vbNo Then
GoTo start
End If
Loop
End Function
Public Function ShExists(strNewSh)
On Error Resume Next
ShExists = Not ThisWorkbook.Sheets(strNewSh) Is Nothing
On Error GoTo 0
End Function
mit freundlichen Grüßen
walter mb