AW: Daten kopieren, Blatt erzeugen VBA
29.09.2016 00:27:09
fcs
Hallo Gerhard,
das makro kann man etwa wie folgt umgestalten.
Gruß
Franz
Sub Stammdaten_sichern()
Dim wksStamm As Worksheet
Dim wksMonat As Worksheet
Dim x As String
Set wksStamm = ActiveWorkbook.Worksheets("Stammdaten")
x = Format(Now(), "MMMM")
Application.ScreenUpdating = False
'ggf. das Monatsblatt neu angelegt werden
If fncCheckSeetName(x, ActiveWorkbook) = False Then
With ActiveWorkbook
.Worksheets.Add after:=.Sheets(.Sheets.Count)
Set wksMonat = ActiveSheet
wksMonat.Name = x
End With
End If
wksStamm.Range("B3:G200").Copy '("B3:G200")
With wksMonat
With .Range("B3")
.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
With .Range("I1")
.Value = Now
.EntireColumn.AutoFit
.Select
End With
End With
wksStamm.Select 'zurück zum Blatt Worksheets(ActiveSheet.Name)
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Public Function fncCheckSeetName(ByVal strSheet As String, Optional wkb As Workbook) As Boolean
Dim objSheet As Object
On Error GoTo Fehler
If wkb Is Nothing Then Set wkb = ActiveWorkbook
Set objSheet = wkb.Sheets(strSheet)
fncCheckSeetName = True
Fehler:
End Function