Zwei Worksheet_Change zusammenführen

[mauritius5]

Liebe Excel-Freunde

Normalerweise mache ich nix mit VBA in Excel. Wenn, dann kopiere ich nur Codes aus dem Internet.
Nun stehe ich vor dem Problem, dass ich zwei Worksheets-Change zusammenführen möchte, dies aber nicht schaffe.

Die beiden Sheets angehängt.

Könnt ihr mir helfen?

Herzlichen Dank und Gruss
mauritius5

[HKindler]

Hi,

wieso steckst du die Codes in eine Word-Datei statt sie einfach hier rein zu kopieren (in Code-Tags)?

Deine beiden Codes sind so gut programmiert, dass du einfach den Inhalt(*) des einen kopieren und am Anfang oder Ende des anderen einfügen kannst.

(*) also alles nach der Zeile Private Sub... und vor End Sub

[mauritius5]

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("G2")) Is Nothing Then
   
    Rows("3:8").EntireRow.Hidden = False
    Columns("a:ae").EntireColumn.Hidden = False
   
    If Range("g2").Value = "Bedarf" Then
        Rows("3:8").EntireRow.Hidden = True
        Columns("j:ad").EntireColumn.Hidden = True
   
    ElseIf Range("g2").Value = "Themenverteilung" Then
        Rows("3:8").EntireRow.Hidden = True
        Columns("x:ad").EntireColumn.Hidden = True
   
    End If

End If

End Sub

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngDV As Range
Dim wert_old As String
Dim wertnew As String

On Error GoTo Errorhandling

If Not Application.Intersect(Target, Range("B4:B14")) Is Nothing Then

  Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
  If rngDV Is Nothing Then GoTo Errorhandling
   
  If Not Application.Intersect(Target, rngDV) Is Nothing Then
    Application.EnableEvents = False
    wertnew = Target.Value
    Application.Undo
    wertold = Target.Value
    Target.Value = wertnew
    If wertold <> "" Then
      If wertnew <> "" Then
        Target.Value = wertold & ", " & wertnew
      End If
    End If
  End If
  Application.EnableEvents = True
End If

Errorhandling:
Application.EnableEvents = True
End Sub

Ich danke dir vielmals. dies mit den Code-Tags wusste ich nicht.

Ich kriegs leider nicht hin bzw. es kommt immer eine Fehlermeldung. Wo genau muss ich es einfügen und was alles?

---

Hat plötzlich doch geklappt

Vielen, Vielen Dank!!!

[HKindler]

Hi,

na z.B. so:

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("G2")) Is Nothing Then
   
    Rows("3:8").EntireRow.Hidden = False
    Columns("a:ae").EntireColumn.Hidden = False
   
    If Range("g2").Value = "Bedarf" Then
        Rows("3:8").EntireRow.Hidden = True
        Columns("j:ad").EntireColumn.Hidden = True
   
    ElseIf Range("g2").Value = "Themenverteilung" Then
        Rows("3:8").EntireRow.Hidden = True
        Columns("x:ad").EntireColumn.Hidden = True
   
    End If

End If

'#################################
'# Hier kommt die zweite Routine #
'#################################
Dim rngDV As Range
Dim wertold As String
Dim wertnew As String

On Error GoTo Errorhandling

If Not Application.Intersect(Target, Range("B4:B14")) Is Nothing Then

  Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
  If rngDV Is Nothing Then GoTo Errorhandling
   
  If Not Application.Intersect(Target, rngDV) Is Nothing Then
    Application.EnableEvents = False
    wertnew = Target.Value
    Application.Undo
    wertold = Target.Value
    Target.Value = wertnew
    If wertold <> "" Then
      If wertnew <> "" Then
        Target.Value = wertold & ", " & wertnew
      End If
    End If
  End If
  Application.EnableEvents = True
End If

Errorhandling:
Application.EnableEvents = True

End Sub

Im übrigen war die Fehlermeldung wahrscheinlich die, dass die Variabe wertold nicht definiert ist. Die war nämlich als wert_old definiert. Ich habe das mal korrigiert.