AW: Kopieren in nächstes freies Blatt
30.11.2016 06:12:54
fcs
Hallo Jakob,
die einfachere Lösung ist wahrscheinlich, das 2. Tabellenblatt mit den Daten zu kopieren und umzubenennen.
Damit es nicht zu Fehlermeldungen kommt bei der Umbenennung des Tabellenblatts hab ich noch eine entsprechende Funktion zur Prüfung des Blattnamens angehängt.
LG
Franz
Sub prcCopyBlatt2()
Dim wksCockpit As Worksheet
Dim wksDaten As Worksheet
Dim wksCopy As Worksheet
Dim strName As String
With ActiveWorkbook
Set wksCockpit = .Sheets(1)
Set wksDaten = .Sheets(2)
End With
'Name des neuen Blattes
strName = wksCockpit.Range("C2").Text & ", " & wksCockpit.Range("C3").Text
If MsgBox("Daten in neues Blatt kopieren?", vbQuestion + vbOKCancel, _
"Rennen - " & strName) = vbCancel Then Exit Sub
'Prüfen, ob der berechnete Name als Blattname zulässig ist
'Bitte beachten, das Blattnamen max. 31 Zeichenlang sein dürfen
'bestimmte Zeichen in Blattnamen nicht zulässig sind * [ ] ? / \ :
'das ' (Hochkomma) als 1. Zeichen nicht zulässig ist
If fncSheetName(strSheetName:=strName) = True Then
With ActiveWorkbook
wksDaten.Copy After:=.Sheets(.Sheets.Count)
End With
Set wksCopy = ActiveSheet
With wksCopy
'Kopiertes Blatt umbenennen
.Name = strName
'Formeln durch Werte ersetzen- Falls erforderlich
.UsedRange.Copy
.UsedRange.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("A1").Select
End With
wksCockpit.Activate
End If
End Sub
Public Function fncSheetName(strSheetName, _
Optional wkb As Workbook) As Boolean
'Prüft, ob strSheetName ein zulässiger Blattname ist
'wkb: Optional andere als die aktive Arbeitsmappe zum prüfen vorgeben
'varNichtGewuenscht Array mit optional nicht gewünschten Zeichen im Blattnamen
'MaxLaenge: Optinal weniger als 31 Zeichen als max. Länge des Blattnamens vorgeben
Dim arrZeichen
Dim Zeichen As String, intZeichen As Integer
Dim strMsg As String
Dim objSheet As Object
If wkb Is Nothing Then Set wkb = ActiveWorkbook
'Unzulässige Zeichen in Blattnamen
arrZeichen = Array("?", ":", "[", "]", "/", "\", "*")
If strSheetName = "" Then
strMsg = "Ein Leerstring ist als Blatt-Name nicht zulässig"
ElseIf Left(strSheetName, 1) = "'" Then
strMsg = "Das Zeichen ""'"" ist als 1.Zeichen im Blatt-Namen nicht zulässig"
ElseIf Len(strSheetName) > 31 Then
strMsg = "Der Blatt-Namen ist länger als die max. zulässig Zeichenzahl von 31"
Else
For Each objSheet In wkb.Sheets
If LCase(strSheetName) = LCase(objSheet.Name) Then
strMsg = "Ein Blatt mit dem Name """ & strSheetName _
& """ ist in Datei """ & wkb.Name & """ schon vorhanden"
GoTo Beenden
End If
Next
For intZeichen = LBound(arrZeichen) To UBound(arrZeichen)
Zeichen = arrZeichen(intZeichen)
If InStr(1, strSheetName, Zeichen) > 0 Then
strMsg = strMsg & " " & Zeichen
End If
Next
If strMsg "" Then strMsg = "Blattname enthält nicht zulässige Zeichen: " & strMsg
End If
Beenden:
If strMsg = "" Then
fncSheetName = True
Else
fncSheetName = False
MsgBox strMsg, vbOKOnly + vbCritical, "Prüfung Blattname"
End If
End Function