Tabellenblatt kopieren
02.02.2018 11:34:23
Christian
dank eurer Hilfe bin ich schon viel weiter gekommen, als eigentlich gedacht und entwickel immer mehr Freude beim Umgang mit Makros.
Allerdings scheitere ich im Moment mit einen Makro, welcher ein Arbeitsblatt (Name KW XX, wobei XX für bspw. KW 01, KW 02, KW 03, ... steht) kopieren (einschl. Formeln, Format, etc.) und fortlaufend nummerieren soll (bspw. KW 05 wird zu KW 06).
Zur Zeit habe ich eine Blanko Wochenvorlage (Name Vorlage), die mit Hilfe des folgenden Makros kopiert wird und ein Makro, welcher die Vorwoche kopiert. Allerdings muss dort die entsprechende Kalenderwoche manuell eingetragen werden was ich nun versuche zu "automatisieren".
Makro für neue Kalenderwoche:
Private Sub CommandButton4_Click()
'CommandButton 4 = Neue Woche beginnen
'Vorlagenblatt kopieren, einfügen und umbenennen mit fortlaufender Nr.
Dim wbAktiv As Workbook
Dim wks As Worksheet
Dim intNrName As Integer
Dim strKopieNeu As String
Const strKopie As String = "KW " 'Startext für Name Blatt-Kopie
Const strVorlage As String = "Vorlage" 'Name des Vorlageblattes
Const varEinfuegeBlatt As Variant = "Vorlage" 'Name oder Nummer des Blatts vor dem eingefügt _
_
werden soll
Const strFormat As String = "00" 'Format für Zählziffer bei Namen
On Error GoTo Fehler
Set wbAktiv = ActiveWorkbook
'Nummer des Neuen Namens ermitteln
'Es wird die höchste Zählnummer der Namen ermittelt, die mit dem Kopie-Namen beginnnen
For Each wks In wbAktiv.Worksheets
With Application.WorksheetFunction
If LCase(Left(wks.Name, Len(strKopie))) = LCase(strKopie) Then
If IsNumeric(Mid(wks.Name, Len(strKopie) + 1)) Then
intNrName = .Max(intNrName, CLng(Mid(wks.Name, Len(strKopie) + 1)))
End If
End If
End With
Next
'Neuen Namen ermitteln
strKopieNeu = strKopie & Format(intNrName + 1, strFormat)
'Neues Blatt anlegen und Name zuweisen
wbAktiv.Worksheets(strVorlage).Copy Before:=wbAktiv.Worksheets(varEinfuegeBlatt)
ActiveSheet.Name = strKopieNeu
Fehler:
With Err
If .Number 0 Then
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End If
End With
End Sub
Derzeitiges Makro für Wochenkopie:
Private Sub CommandButton11_Click()
'Vorwoche kopieren, einfügen und umbenennen mit fortlaufender Nr.
Dim NewName As String
ActiveSheet.Copy After:=ActiveSheet
KW = InputBox("Geben Sie einen Tabellenblattnamen ein")
ActiveSheet.Name = KW
End Sub
Vielen Dank vorab für eure Unterstützung und Ratschläge.
Gruß
Christian