Tabellenblatt mithilfe For-Schleife benennen

Hey ihr,
habe folgendes Makro:

Sub Test()
Dim sht1 As Worksheet
Set sht1 = Sheets("Muster")
Sheets(3).Activate
sht1.Copy before:=ActiveSheet
ActiveSheet.Name = Cells(1, 7)
End Sub

Wenn ich das Makro ausführe, erstellt es mir eine Kopie meines Muster-Tabellenblattes und setzt an die für mich gewünschte Position. Es wird nach dem Zelleninhalt von Cells(1,7), also G1 benannt. Nun möchte ich aber, dass nach jeder Erstellung eines Blattes die Zelle unterhalb angesprochen wird, also Cells(2,7), Cells(3,7) usw. und dementsprechend benannt wird.
Meine Idee ist dies mit einer For-Schleife zu lösen, also im Prinzip so ähnlich

 Dim n as Integer
Dim name as Text
For n=1 to 99
cells(n,7).value=name
Next n

Und unten bei ActiveSheet.Name = Cells(name,7) zu schreiben. Aber durch längeres Rumprobieren komme ich auf keinen grünen Zweig, ich wäre über jegliche Hilfe erfreut.
Beste Grüße!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub test() Dim lngIndex As Long On Error GoTo ErrorHandler Application.ScreenUpdating = False With Sheets(3) For lngIndex = 1 To 99 If IsValidSheetName(.Cells(lngIndex, 7).Text) Then If Not SheetExist(.Cells(lngIndex, 7).Text) Then Sheets("Muster").Copy Before:=Sheets(3) ActiveSheet.Name = .Cells(lngIndex, 7).Text End If End If Next End With ErrorHandler: Application.ScreenUpdating = False End Sub Private Function IsValidSheetName(ByVal strName As String) As Boolean 'Validates a gifen string Dim objRegExp As Object Set objRegExp = CreateObject("vbscript.regexp") With objRegExp .Global = True .Pattern = "^[^\/\\:\*\?\[\]]{1,31}$" .IgnoreCase = True IsValidSheetName = .test(strName) End With Set objRegExp = Nothing End Function Private Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook, Optional ByVal byCodeName As Boolean = False) As Boolean Dim wks As Object On Error GoTo ErrorHandler If Wb Is Nothing Then Set Wb = ThisWorkbook For Each wks In Wb.Sheets If byCodeName Then If LCase(wks.CodeName) = LCase(sheetName) Then SheetExist = True: Exit Function Else If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function End If Next ErrorHandler: SheetExist = False End Function VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Hallo nochmal,
so passt es.
Modul Modul1

Option Explicit 
 
Sub test() 
  Dim lngIndex As Long 
 
  On Error GoTo ErrorHandler 
  Application.ScreenUpdating = False 
   
  With Sheets(3) 
    For lngIndex = 1 To 99 
      If IsValidSheetName(.Cells(lngIndex, 7).Text) Then 
        If Not SheetExist(.Cells(lngIndex, 7).Text) Then 
          Sheets("Muster").Copy Before:=Sheets(3) 
          ActiveSheet.Name = .Cells(lngIndex, 7).Text 
        End If 
      End If 
    Next 
  End With 
   
ErrorHandler: 
  Application.ScreenUpdating = True 
End Sub 
 
Private Function IsValidSheetName(ByVal strName As String) As Boolean 
  'Validates a gifen string 
  Dim objRegExp As Object 
 
  Set objRegExp = CreateObject("vbscript.regexp") 
 
  With objRegExp 
    .Global = True 
    .Pattern = "^[^\/\\:\*\?\[\]]{1,31}$" 
    .IgnoreCase = True 
    IsValidSheetName = .test(strName) 
  End With 
 
  Set objRegExp = Nothing 
 
End Function 
 
Private Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook, Optional ByVal byCodeName As Boolean = False) As Boolean 
  Dim wks As Object 
  On Error GoTo ErrorHandler 
  If Wb Is Nothing Then Set Wb = ThisWorkbook 
  For Each wks In Wb.Sheets 
    If byCodeName Then 
      If LCase(wks.CodeName) = LCase(sheetName) Then SheetExist = True: Exit Function 
    Else 
      If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function 
    End If 
  Next 
ErrorHandler: 
  SheetExist = False 
End Function 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

	A	B	C	D	E	F
1	Gruß Sepp
2
3

Sub Test() Dim i As Integer Dim ws As Worksheet i = 1 Sheets("Muster").Copy before:=Sheets(3) ActiveSheet.Name = Cells(i, 7).Text For Each ws In ActiveWorkbook.Sheets If ws.Name = Cells(i, 7) Then i = i + 1 End If Next ws

Sub test() Dim lngIndex As Long On Error GoTo ErrorHandler Application.ScreenUpdating = False With Sheets(3) For lngIndex = 1 To 99 If IsValidSheetName(.Cells(lngIndex, 7).Text) Then If Not SheetExist(.Cells(lngIndex, 7).Text) Then Sheets("Muster").Copy Before:=Sheets(3) ActiveSheet.Name = .Cells(lngIndex, 7).Text Exit For End If End If Next End With ErrorHandler: Application.ScreenUpdating = False End Sub VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Beliebteste Forumthreads (12 Monate)

Tabellenblatt mithilfe For-Schleife benennen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread