Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1236to1240
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Tabellenblatt mehrfach kopieren - Namen aus Liste

Tabellenblatt mehrfach kopieren - Namen aus Liste
Lutz
Liebe Ex(cel)perten,
ich möchte gern das mehrfache Kopieren und Umbennen von Tabellenblättern automatisieren.
In der Spalte A der Mustermappe befindet sich eine Liste mit den vorgesehenen Blattnamen der Kopien (in meinem Fall A1:A38). Wünschenswert wäre ein Makro, dass soviel Kopien wie erforderlich angelegt (also hier 38) und die Blattnamen aus meiner Liste bezieht.
Im Netz habe ich folgendes schöne Makro von Hajo gefunden:
Option Explicit
Sub Kopie()
Dim InAnzahl As Integer, intI As Integer
InAnzahl = Application.InputBox("Anzahl der kopie (aktuelle Tabelle", "Kopie", 0, Type:=1)
If InAnzahl = 0 Then Exit Sub
For intI = 1 To InAnzahl
ActiveSheet.Copy After:=Sheets(Worksheets.Count)
Next intI
End Sub
Damit lässt sich schon mal die gewünschte Anzahl von Kopien bestimmen. Kann mir jemand bei der Erweiterung des Makros bezüglich der Benennung der Kopien helfen? Meine VBA-Kenntnisse sind leider bescheiden.
Da ich häufiger vor dem Vervielfältigungsproblem stehe, wäre es toll, wenn das Makro flexibel bezüglich der Anzahl der Kopien wäre.
Danke für Eure Hilfe!
Viele Grüße Lutz

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Tabellenblatt mehrfach kopieren - Namen aus Liste
19.11.2011 18:23:11
Hajo_Zi
Hallo Lutz,
ohne Fehlerbehandlung.
Option Explicit
Sub Kopie()
Dim LoAnzahl As Long, LoI As Long
LoAnzahl = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
For LoI = 1 To LoAnzahl
ActiveSheet.Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = Cells(LoI, 1)
Next LoI
End Sub


AW: Tabellenblatt mehrfach kopieren - Namen aus Liste
19.11.2011 18:27:16
Lutz
Hallo Hajo,
ganz große Klasse! Blitzschnell und genau wie ich es mir vorgestellt habe :-)
Dankbare Grüße
Lutz
AW: Tabellenblatt mehrfach kopieren - Namen aus Liste
19.11.2011 18:31:42
Josef

Hallo Lutz,
das geht z. B. so. Die Tabellennamen musst du natürlich entsprechend anpassen.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub kopie2()
  Dim rng As Range
  
  With ThisWorkbook
    For Each rng In .Sheets("Tabelle1").Columns(1).SpecialCells(xlCellTypeConstants).Cells
      If IsValidSheetName(rng.Text) Then
        If Not SheetExist(rng.Text) Then
          .Sheets("Tablle2").Copy After:=.Sheets(.Sheets.Count)
          .Sheets(.Sheets.Count).Name = rng.Text
        End If
      End If
    Next
  End With
  
End Sub


Private Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
  Dim wks As Worksheet
  On Error GoTo ERRORHANDLER
  If Wb Is Nothing Then Set Wb = ThisWorkbook
  For Each wks In Wb.Worksheets
    If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function
  Next
  ERRORHANDLER:
  SheetExist = False
End Function


Private Function IsValidSheetName(ByVal strName As String) As Boolean
  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



« Gruß Sepp »

Anzeige
AW: Tabellenblatt mehrfach kopieren - Namen aus Liste
19.11.2011 23:30:17
Lutz
Hallo Sepp,
zunächst erhielt ich die Fehlermeldung "Index außerhalb des gültigen Bereichs".
Es lag offensichtlich an einem kleinen Tippfehler in der 8. Zeile deines Makros: "Tablle 2". Nach der Korrektor läuft auch Dein Makro einwandfrei.
Danke auch Dir ganz herzlich!
Viele Grüße
Lutz

314 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige