Automatisk skjul af inaktive rækker ved brug af makroer

Prøv med denne makro. Den aktiveres når der skrives i kolonne B

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
Application.ScreenUpdating = False
Range("B5:B60").EntireRow.Hidden = False
For x = 6 To 60
If Cells(x, 2) = "" And Cells(x - 1, 2) = "" Then
Cells(x, 2).EntireRow.Hidden = True
Else
Cells(x, 2).EntireRow.Hidden = False
End If
Next
Application.ScreenUpdating = True
End If
End Sub

Mange tak!
Lige præcis hvad jeg søgte. Hvis du sender et svar, så skal jeg nok lige give point.

Godt det kunne bruges

Hvis nu jeg i øvrigt har flere tabeller ned igennem arket med samme udseende, som skal gøre det samme?

Fandt ud af det.

Så kan du gentage en del af makroen. Jeg har lavet et eksempel nedenfor, hvor den også checker linerne fra 80 til 120. Ret selv til. Der er sat et par tomme linier ind så det er let at se hvad der skal gentages

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
Application.ScreenUpdating = False

Range("B5:B60").EntireRow.Hidden = False
For x = 6 To 60
If Cells(x, 2) = "" And Cells(x - 1, 2) = "" Then
Cells(x, 2).EntireRow.Hidden = True
Else
Cells(x, 2).EntireRow.Hidden = False
End If
Next

Range("B80:B120").EntireRow.Hidden = False
For x = 80 To 120
If Cells(x, 2) = "" And Cells(x - 1, 2) = "" Then
Cells(x, 2).EntireRow.Hidden = True
Else
Cells(x, 2).EntireRow.Hidden = False
End If
Next

Application.ScreenUpdating = True
End If
End Sub

Fantastisk! Mange tak!