Hændelse ved indtastninger i felter

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A2")) Is Nothing Then
If Target.Row = 1 Then
    Sheets("1").Visible = True
    Sheets("2").Visible = True
    Sheets("3").Visible = True
Else
    Sheets("4").Visible = True
    Sheets("5").Visible = True
    Sheets("6").Visible = True
End If
End If
End Sub

Måske har jeg ikke været konkret nok:

Hvis der er skrevet i A1, skal 1,2 og 3 åbne
Hvis der er skrevet i A2, skal 4,5 og 6 åbne

Hvis der er skrevet i A2, men ikke i A1, skal kun 4,5 g 6 åbne.
Hvis der er skrevet i A1, men ikke i A2, skal kun 1,2 og 3 åbne.

Så skal der bare lukkes for samtlige ark minus forsiden først. Ret selv til hvis den ikke hedder "Forside":

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A2")) Is Nothing Then
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "Forside" Then
ws.Visible = False
End If
Next
If Target.Row = 1 Then
    Sheets("1").Visible = True
    Sheets("2").Visible = True
    Sheets("3").Visible = True
Else
    Sheets("4").Visible = True
    Sheets("5").Visible = True
    Sheets("6").Visible = True
End If
End If
End Sub

Eller denne hvis du vil have at siderne 1 til 6 alle skal være åbne, når der er skrevet i begge celler:

If Not Intersect(Target, Range("A1:A2")) Is Nothing Then
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "Forside" Then
ws.Visible = False
End If
Next
If Range("A1") <> "" Then
    Sheets("1").Visible = True
    Sheets("2").Visible = True
    Sheets("3").Visible = True
End If
If Range("A2") <> "" Then
    Sheets("4").Visible = True
    Sheets("5").Visible = True
    Sheets("6").Visible = True
End If
End If
End Sub

Hm.
Det virker ikke helt efter hensigten.

Her den rigtige kode:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D16:D42")) Is Nothing Then
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "INDSKRIV" Then
ws.Visible = False
End If
Next
If Target.Row = 1 Then
    Sheets("1").Visible = True
    Sheets("2").Visible = True
    Sheets("Toldfaktura  - 1").Visible = True
    Sheets("Følgeseddel 1").Visible = True
Else
    Sheets("3").Visible = True
    Sheets("4").Visible = True
    Sheets("Toldfaktura  - 1").Visible = True
    Sheets("Følgeseddel 1").Visible = True
End If
End If
End Sub


Når jeg taster i D16: skulle (1),(2),(Toldfaktura -1), og (Følgeseddel 1) åbne.
Den åbner (3), (4), (Toldfaktura -1), og (Følgeseddel 1).

Der er i virkeligheden flere rækker med flere faner der skal åbne, men jeg tænker, at hvis jeg kan få disse to til at virke, kan resten nok også falde på plads.

If Target.Row = 1 Then

skal ændres til

If Target.Row = 16 Then

Efter ændring:
Når jeg skriver i felt D17: Åbner de rigtige.
Men når jeg skriver i D16 åbner de rigtige, men den lukker de andre.
Og omvendt.
Det er meningen, at efterhånden som D16,D17,D18 osv. bliver udfyldt, skal de tilhørende faner åbne, og forblive åben.
Det virker som om vi er tæt på nu.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D16:D42")) Is Nothing Then
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "INDSKRIV" Then
ws.Visible = False
End If
Next
If Target.Row = 16 Then
    Sheets("1").Visible = True
    Sheets("2").Visible = True
    Sheets("Toldfaktura  - 1").Visible = True
    Sheets("Følgeseddel 1").Visible = True
End if
If Target.Row = 17 Then
    Sheets("3").Visible = True
    Sheets("4").Visible = True
    Sheets("Toldfaktura  - 1").Visible = True
    Sheets("Følgeseddel 1").Visible = True
End If


End If
End Sub

Og i mellemrummet kan du fortsætte med

If Target.Row = 18 Then
    Sheets("5").Visible = True
    Sheets("6").Visible = True
    Sheets("Toldfaktura  - 1").Visible = True
    Sheets("Følgeseddel 1").Visible = True
End If

osv.

Hmm.
Stadig ikke helt som det skal være.
Når jeg taster i D16, gør den det rigtigt.
Når jeg så bagefter taster i D17, åbner den rigtig nok, men den lukker dem som D16 lige har åbnet. De skal forblive åbne.
Det skal være sådan, at der hvor der er tastet (imellem D16 og D42), der skal de faner, som passer til, være åbne.
Hvis jeg kun skulle taste i 'en af rækkerne, ville det være fint nok, men sådan er det desværre ikke.

Du skulle have arbejdet videre med det forslag jeg havde i #4. Men prøv med denne:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D16:D42")) Is Nothing Then
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "INDSKRIV" Then
ws.Visible = False
End If
Next
If Range("D16")<>"" Then
    Sheets("1").Visible = True
    Sheets("2").Visible = True
    Sheets("Toldfaktura  - 1").Visible = True
    Sheets("Følgeseddel 1").Visible = True
End if
If Range("D17")<>"" Then
    Sheets("3").Visible = True
    Sheets("4").Visible = True
    Sheets("Toldfaktura  - 1").Visible = True
    Sheets("Følgeseddel 1").Visible = True
End If


End If
End Sub

Og i mellemrummet kan du fortsætte med

If Range("D18")<>"" Then
    Sheets("5").Visible = True
    Sheets("6").Visible = True
    Sheets("Toldfaktura  - 1").Visible = True
    Sheets("Følgeseddel 1").Visible = True
End If

Perfekt.
Tusind tak for hjælpen.
Laver du et svar, så jeg kan give point?

Et svar