Am Monatsende Werte übertragen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Activate() Dim Datum As Date, Sp As Integer, RNG As Range Set RNG = Rows(3) 'Erster der Vormonats Datum = DateSerial(Year(Date), Month(Date) - 1, 1) 'Datum vorhanden Sp = WorksheetFunction.CountIf(RNG, CDbl(Datum)) 'in welcher Spalte If Sp > 0 Then Sp = WorksheetFunction.Match(CDbl(Datum), RNG, 1) Else MsgBox "Monatsfehler" Exit Sub End If 'Hat Zelle eine Formel? With Intersect(RNG, Columns(Sp)).Offset(1, 0) 'Schnittmenge aus Zeile und Spalte 'Wenn Formel, dann als Wert festschreiben If .HasFormula Then .Value = .Value End If End With End Sub

Private Sub Workbook_Open() Dim Tb As Worksheet Dim Datum As Date, Sp As Integer, RNG As Range 'Erster der Vormonats Datum = DateSerial(Year(Date), Month(Date) - 1, 1) For Each Tb In ThisWorkbook.Sheets Select Case Tb.Name Case "DiesesBlattNicht", "Das auch nicht", "Tabelle 99" 'mach nichts Case Else Set RNG = Tb.Rows(3) 'Datum vorhanden Sp = WorksheetFunction.CountIf(RNG, CDbl(Datum)) 'in welcher Spalte If Sp > 0 Then Sp = WorksheetFunction.Match(CDbl(Datum), RNG, 1) Else MsgBox "Monatsfehler auf Blatt: " & Tb.Name & vbLf & vbLf & "Bearbeitung gestoppt" Exit Sub End If 'Hat Zelle eine Formel? With Intersect(RNG, Tb.Columns(Sp)).Offset(1, 0) 'Schnittmenge aus Zeile und Spalte 'Wenn Formel, dann als Wert festschreiben If .HasFormula Then .Value = .Value End If End With End Select Next End Sub

Hallo
Habe auf Zeile 16 geändert
und prüfe, nun ob der erste Monat der Aktuelle ist. Dann KEIN Fehler
Formatiert sollte Zeile 16 sein als Datum


Private Sub Workbook_Open()
Dim Tb As Worksheet, MinDat As Date
Dim Datum As Date, Sp As Integer, RNG As Range
'Erster der Vormonats
Datum = DateSerial(Year(Date), Month(Date) - 1, 1)
For Each Tb In ThisWorkbook.Sheets
Select Case Tb.Name
Case "DiesesBlattNicht", "Das auch nicht", "Tabelle 99"
'mach nichts
Case Else
Set RNG = Tb.Rows(16)
'Datum vorhanden
Sp = WorksheetFunction.CountIf(RNG, CDbl(Datum))
'in welcher Spalte
If Sp > 0 Then
Sp = WorksheetFunction.Match(CDbl(Datum), RNG, 1)
Else
MinDat = WorksheetFunction.Min(RNG)
If MinDat > Datum Then
'Es gibt keinen Vormonat aber den aktuellen Monat
'Also keinen Fehler ausgeben
'mache nichts
GoTo Weiter
Else
MsgBox "Monatsfehler auf Blatt: " & Tb.Name & vbLf & vbLf & "Bearbeitung gestoppt"
Exit Sub
End If
End If
'Hat Zelle eine Formel?
With Intersect(RNG, Tb.Columns(Sp)).Offset(1, 0) 'Schnittmenge aus Zeile und Spalte
'Wenn Formel, dann als Wert festschreiben
If .HasFormula Then
.Value = .Value
End If
End With
End Select
Weiter:
Next
End Sub

LG UweD

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread