Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
952to956
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
952to956
952to956
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Blätter duplizieren und benennen

Blätter duplizieren und benennen
20.02.2008 17:29:36
udoof
Hallo Leute,
Ich habe eine Arbeitsmappe als Vorlage. Diese enthält ein Blatt ("Dokumentation") als Übersicht und ein weiteres Blatt ("0000") als Muster zur Datenauswertung. Ich möchte nun folgendes machen:
Im Übersichts-Blatt die Namen der gewünschten Blätter eingeben (0001, 0002, 0003 ...). Dann per Knopfdruck das Muster-Arbeitsblatt mehrfach kopieren (in der gleichen Arbeitsmappe) und die Namen entsprechend vergeben. Idealerweise erkennt das Skript, wieviele Kopien benötigt werden (die Namen sind in einer Liste untereinander, Anzahl ist variabel).
Die Mappe wird dann unter neuem Namen gespeichert.
Ich habe per Makro-Recorder das Kopieren und Umbenennen eines Sheets aufgezeichnet, bin aber nicht in der Lage, den Namen dort variabel zu gestalten.
Ich wäre Euch sehr dankbar, wenn mir jemand helfen kann.
grüßle,
Udo

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Blätter duplizieren und benennen
20.02.2008 18:27:00
Josef
Hallo Udo,
das geht zB. so.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub BlattKopieren()
Dim lngR As Long, lngLast As Long, lngFirst As Long
Dim intC As Integer

lngFirst = 2 'erste Zeile mit den Blattnamen - anpassen!
intC = 1 'Spalte mit den Blattnamen - anpassen!

With ThisWorkbook.Sheets("Dokumentation")
    lngLast = Application.Max(.Cells(Rows.Count, intC).End(xlUp).Row, lngFirst)
    
    For lngR = lngFirst To lngLast
        If IsValidSheetName(.Cells(lngR, intC).Text) And Not SheetExist(.Cells(lngR, intC).Text) Then
            ThisWorkbook.Sheets("0000").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = .Cells(lngR, intC).Text
        End If
    Next
End With

End Sub

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

Private Function SheetExist(ByVal sheetName As String, Optional WbName As String) As Boolean
Dim wks As Worksheet
On Error GoTo ERRORHANDLER
If WbName = "" Then WbName = ThisWorkbook.Name
For Each wks In Workbooks(WbName).Worksheets
    If wks.Name = sheetName Then SheetExist = True: Exit Function
Next
ERRORHANDLER:
SheetExist = False
End Function


Gruß Sepp



Anzeige
AW: Blätter duplizieren und benennen
20.02.2008 18:30:38
Horst
Hi,
saubere Lösung.
mfg Horst

Vielen Dank!
21.02.2008 09:07:00
udoof
Hallo Sepp,
Super Sache. Sogar mit Fehlerbehandlung. Ich bin Dir zu tiefstem Dank verpflichtet. Solltest Du jemals ein Problem mit Director/Lingo haben, stehe ich zu Diensten ;-)
Die einzige Änderung, die ich machen musste, war das Einfügen der Quelle:
' By Josef Ehrensberger - Herbers Excel-Forum
Grüßle,
Udo

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige