Hallo Sebbi,
so in etwa sollte es funktionieren:
Sub Ausblenden()
Dim rngXse As Range, rngT As Range
Set rngXse = Application.Union(Range("B18,B301,B313,B325,B371,B380,B470,B475"), _
Range("C20,C58,C66,C93,C167,C211,C233,C257,C327,C349,C382,C384,C386,C422,C438,C450,C458,C472,C477,C491"), _
Range("D95,D145,D153,D159,D303,D305,D307,D309,D311,D315,D317,D319,D321,D323,D331,D336,D339,D343,D351,D367,D369"), _
Range("F22,F36,F42,F48,F50,F54,F60,F64,F68,F70,F72,F74,F76,F78,F80,F82,F84,F97,F99,F101,F103,F105,F107,F109,F111,F115,F119,F123,F127,F129,F131,F133,F135,F137,F139,F141,F143,F147,F149,F151,F155,F157,F161,F163,F165,F169,F181,F185,F197,F213,F223,F229,F235,F249,F253"), _
Range("F259,F269,F285,F329,F345,F347,F353,F355,F357,F361,F365,F388,F418,F420,F424,F426,F428,F430,F434,F436,F440,F442,F444,F446,F448,F452,F454,F456,F460,F462,F464,F466,F468,F480,F482,F485,F489"), _
Range("H24,H26,H28,H30,H32,H34,H38,H40,H44,H46,H52,H62,H87,H89,H91,H113,H117,H121,H125,H171,H173,H175,H177,H179,H183,H187,H189,H191,H193,H195,H199,H201,H203,H205,H207,H209,H215,H217,H219,H221,H225,H227,H231,H237,H239,H241,H243,H245,H247,H251,H255,H261,H263,H265"), _
Range("H267,H271,H273,H275,H277,H279,H281,H283,H287,H289,H291,H293,H295,H297,H299,H390,H392,H394,H396,H398,H400,H402,H404,H406,H408,H410,H412,H414,H416,H432"))
Application.ScreenUpdating = False
For Each rngT In rngXse
If rngT.Value = "" Then
If rngT.EntireRow.Hidden = False Then
rngT.Value = "Y"
rngT.EntireRow.Resize(2).Hidden = True
End If
End If
Next rngT
Application.ScreenUpdating = True
End Sub
Sub Einblenden()
Dim rngYse As Range, rngT As Range
Set rngYse = Application.Union(Range("B18,B301,B313,B325,B371,B380,B470,B475"), _
Range("C20,C58,C66,C93,C167,C211,C233,C257,C327,C349,C382,C384,C386,C422,C438,C450,C458,C472,C477,C491"), _
Range("D95,D145,D153,D159,D303,D305,D307,D309,D311,D315,D317,D319,D321,D323,D331,D336,D339,D343,D351,D367,D369"), _
Range("F22,F36,F42,F48,F50,F54,F60,F64,F68,F70,F72,F74,F76,F78,F80,F82,F84,F97,F99,F101,F103,F105,F107,F109,F111,F115,F119,F123,F127,F129,F131,F133,F135,F137,F139,F141,F143,F147,F149,F151,F155,F157,F161,F163,F165,F169,F181,F185,F197,F213,F223,F229,F235,F249,F253"), _
Range("F259,F269,F285,F329,F345,F347,F353,F355,F357,F361,F365,F388,F418,F420,F424,F426,F428,F430,F434,F436,F440,F442,F444,F446,F448,F452,F454,F456,F460,F462,F464,F466,F468,F480,F482,F485,F489"), _
Range("H24,H26,H28,H30,H32,H34,H38,H40,H44,H46,H52,H62,H87,H89,H91,H113,H117,H121,H125,H171,H173,H175,H177,H179,H183,H187,H189,H191,H193,H195,H199,H201,H203,H205,H207,H209,H215,H217,H219,H221,H225,H227,H231,H237,H239,H241,H243,H245,H247,H251,H255,H261,H263,H265"), _
Range("H267,H271,H273,H275,H277,H279,H281,H283,H287,H289,H291,H293,H295,H297,H299,H390,H392,H394,H396,H398,H400,H402,H404,H406,H408,H410,H412,H414,H416,H432"))
Application.ScreenUpdating = False
For Each rngT In rngYse
If rngT.Value = "Y" Then
rngT.Value = ""
rngT.EntireRow.Resize(2).Hidden = False
End If
Next rngT
Application.ScreenUpdating = True
End Sub
Gruß Uwe