Kopiertes Blatt benennen Text + 2 Zellen

Forumthread: Kopiertes Blatt benennen Text + 2 Zellen

07.01.2015 17:37:48

Andreas

Hallo Forum,
ich habe im Netz folgenden Code gefunden:


Sub AbholSpeichern()
Dim NeuerTabellenName As String
'Neuen TabellenName aus Zelle B14 holen und merken
NeuerTabellenName = ActiveSheet.Range("B14").Value
'Tabelle kopieren und hinter der letzten Tabelle einfügen
ActiveSheet.Copy After:=Sheets(Sheets.Count)
'der neuen Tabelle den Name geben
Sheets(Sheets.Count).Name = NeuerTabellenName
End Sub

Das funktioniert auch super. Nun müsste sich der neue Name aber folgendermaßen zusammensetzen:
Blatt-Inhalt Zelle C11-Inhalt Zelle B14
Wenn das Blatt schon vorhanden ist soll eine weitere Kopie erstellt werden.
Außerdem soll das neue Blatt nicht nach dem letzten sondern vor das 1. Blatt kopiert werden.
Kann mir bitte Jemand helfen!
Danke fürs lesen.
mfg, Andeas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Kopiertes Blatt benennen Text + 2 Zellen

07.01.2015 19:32:11

Andreas

Bin schon ein wenig weiter. Habe den Blattnamen (etwas umgestellt) schon fertig.


'Neuen TabellenName aus Zelle B14 holen und merken
NeuerTabellenName = ActiveSheet.Range("C11").Value & " - " & ActiveSheet.Range("B14").Value & "  _
- " & "Text"

Allerdings kommt natürlich eine Fehlermeldung, wenn der Name schon vorhanden ist.
Wie muss der Code geändert werden, wenn bei schon vorhandenen Blattnamen einfach noch eine Kopie angelegt wird.
mfg, Andreas

AW: Kopiertes Blatt benennen Text + 2 Zellen

08.01.2015 15:02:25

Dieter

Hallo Andreas,
du kannst das mit dem folgenden Programm machen (Den Blattnamen "Original" ersetzt du durch den Namen deines zu kopierenden Blattes):

Sub AbholSpeichern()
Dim anzKopien As Long
Dim NeuerTabellenName As String
Dim wb As Workbook
Dim wsK As Worksheet  ' Kopie
Dim wsO As Worksheet  ' Original
Set wb = ThisWorkbook
Set wsO = wb.Worksheets("Original")
NeuerTabellenName = wsO.Range("C11") & " - " & wsO.Range("B14") & " - Text"
If Not BlattExistiert(wb, NeuerTabellenName) Then
wsO.Copy Before:=wb.Sheets(1)
Set wsK = ActiveSheet
wsK.Name = NeuerTabellenName
Else
anzKopien = 1
Do Until Not BlattExistiert(wb, NeuerTabellenName & anzKopien)
anzKopien = anzKopien + 1
Loop
wsO.Copy Before:=wb.Sheets(1)
Set wsK = ActiveSheet
wsK.Name = NeuerTabellenName & anzKopien
End If
End Sub
Function BlattExistiert(Mappe As Workbook, Blattname As String) As Boolean
Dim sh As Object
For Each sh In Mappe.Sheets
If UCase$(Blattname) = UCase$(sh.Name) Then
BlattExistiert = True
Exit Function
End If
Next sh
End Function

Die zugehörige Datei findest du hier:
https://www.herber.de/bbs/user/94844.xls
Viele Grüße
Dieter

AW: Kopiertes Blatt benennen Text + 2 Zellen

09.01.2015 08:02:36

Andreas

Hallo Dieter,
danke für die Hilfe, werde es heute Abend mal testen und Rückmeldung geben.
mfg, Andreas

Vielen Dank, das habe ich gesucht! owT

09.01.2015 21:43:24

Andreas

Beliebteste Forumthreads (12 Monate)

Kopiertes Blatt benennen Text + 2 Zellen

Forumthread: Kopiertes Blatt benennen Text + 2 Zellen

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread