Bei Fehleingabe Tabellenwechsel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Ina!
Kopiere diesen Code in das Modul "DieseArbeitsmappe".
(Rechtsklick auf das Excelsymbol ganz links oben neben "Datei" &gt Code anzeigen und in das rechte Fenster einfügen)

' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Const cFormat As String = "mmmm" 'Wenn die Tabellen "Januar, Februar, März, ... heisen
' "mmm" 'Wenn die Tabellen "Jan, Feb, Mrz, ... heisen

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim dDate As Date
Dim lngNext As Long
On Error GoTo ErrExit
Application.EnableEvents = False
If IsDate(DateValue("2007/" & Sh.Name & "/1")) Then
  If Target.Count = 1 And Target <> "" Then
    If IsDate(Target) Then
      If Month(Target) <> Month(DateValue("2007/" & Sh.Name & "/1")) Then
        dDate = Target
        Target.ClearContents
        With Sheets(Format(dDate, cFormat))
          lngNext = .Range("C151").End(xlUp).Row + 1
          If lngNext < 8 Then lngNext = 8
          .Cells(lngNext, 3) = dDate
          .Activate
          .Cells(lngNext, 3).Select
        End With
      End If
    End If
  End If
End If
ErrExit:
Application.EnableEvents = True
End Sub

Gruß Sepp

Hallo Ina!
Nimm diesen Code.

' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim dDate As Date
Dim iYear As Integer
On Error GoTo ErrExit
Application.EnableEvents = False
iYear = Sheets("Januar").Range("B3").Value
If IsDate(DateValue("2007/" & Sh.Name & "/1")) Then
  If Target.Count = 1 And Target <> "" Then
    If IsDate(Target) Then
      If Month(Target) <> Month(DateValue("2007/" & Sh.Name & "/1")) Then
        dDate = Target
        If Year(dDate) = iYear Then
          Target.ClearContents
          moveDate dDate
        Else
          MsgBox "Wohl im falschen Jahr gelandet!", 48, "Falsche Jahr"
          Target.Select
        End If
      End If
    End If
  End If
End If
ErrExit:
Application.EnableEvents = True
End Sub

Private Sub moveDate(fDate As Date)
Dim lngNext As Long
Dim objSh As Worksheet

For Each objSh In Me.Worksheets
  If IsDate(DateValue("2007/" & objSh.Name & "/1")) Then
    If Month(fDate) = Month(DateValue("2007/" & objSh.Name & "/1")) Then
      With objSh
        lngNext = .Range("C151").End(xlUp).Row + 1
        If lngNext < 8 Then lngNext = 8
        .Cells(lngNext, 3) = fDate
        .Activate
        .Cells(lngNext, 3).Select
      End With
      Exit For
    End If
  End If
Next

End Sub

Jetzt ist es auch egal, ob die Tabellen "Jan", "Feb", "Mrz", ..., oder "Januar, "Februar", "März", ... heisen.

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread