Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim meAr(), MaxWert As Long, LCount As Long
Dim rngBereich As Range
Dim MaxRow As Long
Dim strMeldung As String
MaxRow = Cells(Rows.Count, 13).End(xlUp).Row
Set rngBereich = Range("C5:J" & MaxRow)
If Intersect(rngBereich, Target) Is Nothing Then Exit Sub
With Application.WorksheetFunction
For Each rngBereich In rngBereich.Rows
MaxWert = .Max(rngBereich)
If MaxWert > Cells(rngBereich.Row, 13) Then
Redim Preserve meAr(LCount)
meAr(LCount) = Sheets(rngBereich.Row - 3).Name
LCount = LCount + 1
End If
Next rngBereich
End With
If LCount > 0 Then
strMeldung = "Sollen diese Tabellen jetzt gedruckt werden?" & vbCr
strMeldung = strMeldung & "-" & Join(meAr, vbCr & "-")
If MsgBox(strMeldung, vbYesNo + vbQuestion) = vbYes Then
For LCount = Lbound(meAr) To Ubound(meAr)
Sheets(meAr(LCount)).PrintOut
Next LCount
End If
End If
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen