|
Hallo,
teste mal:
Option Explicit
Public Sub aaa()
Dim ws As Worksheet, loJahr As Long, loJahrAlt As Long
Dim loMonat As Long, loMonatAlt As Long
Dim daDatum As Date, daDatumAlt As Date
Dim strBlattNeu As String, strBlattAlt As String
Application.ScreenUpdating = False
'Blattname für neues Blatt erstellen
strBlattNeu = Format(DateSerial(Year(Date), Month(Date), 1), "MMMM") & " " & Year(Date)
'Prüfung ob dieses Blatt schon existiert
For Each ws In ThisWorkbook.Worksheets
If ws.Name = strBlattNeu Then
MsgBox "Fehler: Das Blatt existiert bereits."
Exit Sub
End If
Next ws
'letztes Blatt kopieren und am Ende einfügen
Worksheets(Sheets.Count).Copy After:=Worksheets(Sheets.Count)
'neues Blatt umbenennen
ActiveSheet.Name = strBlattNeu
loMonat = Month(Date) - 1
If loMonat = 1 Then
loJahr = Year(Date) - 1
Else
loJahr = Year(Date)
End If
loMonatAlt = Month(Date) - 2
If loMonatAlt <= 2 Then
loJahrAlt = Year(Date) - 1
Else
loJahrAlt = Year(Date)
End If
daDatum = DateSerial(Year(Date), loMonat, 1)
daDatumAlt = DateSerial(Year(Date), loMonatAlt, 1)
strBlattNeu = Format(daDatum, "MMMM") & " " & loJahr
strBlattAlt = Format(daDatumAlt, "MMMM") & " " & loJahrAlt
Columns("G").Replace What:=strBlattAlt, Replacement:=strBlattNeu, _
LookAt:=xlPart, FormulaVersion:=xlReplaceFormula
End Sub
Gruß Werner
|