Habe insgesamt 75 Reihen.
Danke für eure Hilfe
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
Gruß Tino