Zellen einfärben über alle Tabellenblätter
16.01.2017 21:29:05
Mooslechner
ich habe ein bestehendes Makro umgebaut.
Aber das Makro läuft nicht über alle Tabellenblätter
Mittels MSG Box gebe ich eine 6. stellige Maschinennummer ein.
Beim Durchlaufen der Spalte B wird aus der Zelle jeweils die linken 6 Zahlen ermittelt. Wenn gleich, dann Zeile rot, nächste Zelle in Spalte B.
Tabellenblatt Gesamt bleibt unberührt.
Irgendwas habe ich übersehen, komme nicht drauf.
Auf jeden Fall schon mal vielen Dank, falls sich jemand meinem Problem annimmt.
Public Sub Einfärben_über_alle_Seiten()
'Sub Rote_Zeilen_einfärben_über_alle_Tabblätter()
Dim rngBereich As Range
Dim rngZelle As Range
Dim loLetzteQ As Long
Dim loLetzteZ As Long
Dim ws As Worksheet
Dim VarSt As String
Dim t As Integer
'Input box öffnen
VarSt = InputBox("Hier die" & Chr(13) & "Maschinennummer eingeben:")
Debug.Print VarSt
For Each ws In ThisWorkbook.Worksheets
If ws.Name "Gesamt" Then
With ws
t = 1
Debug.Print t
'ermittelt die letzte Zeile
loLetzteQ = .Cells(.Rows.Count, 2).End(xlUp).Row
Debug.Print loLetzteQ
Set rngBereich = .Range(.Cells(1, 1), .Cells(loLetzteQ, 1))
For Each rngZelle In rngBereich
If Left(Cells(t, 2).Value, 6) = VarSt Then
Rows(t).Interior.Color = vbRed
End If
t = t + 1
Next rngZelle
End With
End If
Next ws
MsgBox " Alle eingefärbt!", vbInformation, "Mitteilung"
End Sub
Anzeige