Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1448to1452
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Tabellenblatt kopieren mit weiterer Datumsfunktion

Tabellenblatt kopieren mit weiterer Datumsfunktion
11.10.2015 23:16:17
Stefan
Hallo!
Ich habe folgendes Problem.
Ich habe eine Tabelle diese soll 52 Tabellenblätter haben mit KW1 und KW2 usw.
Das hätte ich bereits durch ein Makro gelöst und funktioniert super. KW steht für _ Kalenderwoche

Sub KW()
Dim i
For i = 2 To 53
Sheets(1).Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = "KW" & i - 1
Next
End Sub

Jetzt möchte ich es noch weiter ergänzen und zwar das er mir in die Zellen B3:F3 (Mo - Fr) automatisch das Datum von der KW1 schreibt.
Das heißt KW1 wäre zb. 01.01.16 und ein Freitag würde dann in Zelle F3 gehören
KW2 dann in
04.01.16 in Zelle B3
05.01.16 in Zelle C3
usw
Immer von Mo - Fr
Weiteres soll er mir in mir in Zelle G1 automatisch den selben Namen wie mein Tabellenblatt schreiben das heißt KW1 soll dann auch in Zelle G1 stehen usw.
Ist sowas möglich? Hat einer Idee wie man das umsetzen kann? Muss man da die Kalenderwochen in einem extra Tabellenblatt definieren?
Vielleicht so?
KW1 wäre nur der 01.01.16 also nur Mo - Fr
Kw2 dann 04.01.16 - 08.01.16 usw?

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

Betreff
Datum
Anwender
Anzeige
AW: Tabellenblatt kopieren mit weiterer Datumsfunktion
11.10.2015 23:59:04
Sepp
Hallo Stefan,
ohne Fehlerbehandlun wenn z. B. die KW-Blätter schon existieren!
' **********************************************************************
' Modul: Modul3 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub BlaetterAnlegen()
Dim varYear As Variant, lngWeek As Long, lngDay As Long
Dim datWeek As Date

varYear = Application.InputBox("Bitte gewünschtes Jahr eingeben:", "Blätter anlegen", CStr(Year(Date)), Type:=2)

If Not varYear = False Then
  For lngWeek = 1 To 53
    datWeek = DateFromKW(varYear, lngWeek)
    If Year(datWeek) = Clng(varYear) Or Year(datWeek + 4) = Clng(varYear) Then
      Sheets(1).Copy After:=Sheets(Sheets.Count)
      With Sheets(Sheets.Count)
        .Name = "KW" & lngWeek
        .Range("G1") = .Name
        For lngDay = 0 To 4
          'B3:F3
          .Cells(3, 2 + lngDay) = datWeek + lngDay
        Next
      End With
    End If
  Next
End If

End Sub

Private Function DateFromKW(ByVal Year As Integer, ByVal KW As Integer) As Date
DateFromKW = DateSerial(Year, 1, 7 * KW - 3 - Weekday(DateSerial(Year, 1, 1), 7))
End Function

Gruß Sepp

Anzeige
AW: Tabellenblatt kopieren mit weiterer Datumsfunktion
12.10.2015 23:55:49
Stefan
Vielen Dank Sepp für deine Hilfe!
Dein Code funktioniert ansich super für das Jahr 2015, aber leider nicht ganz für 2016. Da stimmt dann das Datum nicht mit der jeweiligen Kalenderwoche überein und ist immer um eine Woche nach hinten verschoben.
Den im Jahr 2016 müssten es dann genau 52 Wochen sein.

313 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige