Daten kopieren, Blatt erzeugen VBA

Forumthread: Daten kopieren, Blatt erzeugen VBA

28.09.2016 18:01:48

Gerhard

Hallo Excelenten,
in einer Datei sollen die Daten des Blattes "Stammdaten" per Makro auf das aktuelle Monatsblatt (z. B. September_2016) gesichert werden. Das Monatsblatt wird anhand des aktuellen Monats ausgewählt. Diese Sicherung muss nicht jeden Monat erfolgen. Deshalb soll das nicht vorhandene, benötigte Monatsblatt per Makro erzeugt werden.
Die vereinfachte Beispieldatei beinhaltet meine bisherigen Möglichkeiten. Das Makro sollte bitte auch verbessert werden.
https://www.herber.de/bbs/user/108490.xlsm
Für Hilfe und ggf. bearbeitete Datei bin ich dankbar.
Gruß
Gerhard

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Daten kopieren, Blatt erzeugen VBA

29.09.2016 00:27:09

fcs
AW: Daten kopieren, Blatt erzeugen VBA

29.09.2016 01:30:34

Gerhard

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

AW: Daten kopieren, Blatt erzeugen VBA

29.09.2016 01:30:34

Gerhard

Vielen Dank Franz!
Deine Nachtlieferung fkt. genau "wie bestellt"!
Viele Grüße
Gerhard

Beliebteste Forumthreads (12 Monate)

Daten kopieren, Blatt erzeugen VBA

Forumthread: Daten kopieren, Blatt erzeugen VBA

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread