VBA Zellen dublizieren plus Wenn Dann Funktion

gelöstFrage VB for Applications Entwicklung

Hi Leute,

ich möchte 2 Zellen unter bestimmten Bedingungen duplizieren. Vereinfachtes Beispiel:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F4")) Is Nothing Then
On Error GoTo Errorhandler
Application.EnableEvents = False
Range("G4").Value = Target.Value
End If
Errorhandler:
Application.EnableEvents = True

End Sub

Jetzt soll nur dupliziert werden, wenn A1 = 1

Wenn A1 = 2 soll F4 mit H4 dupliziert werden.

Ich brauche ca. 20 Bedingungen

Ist das realisierbar?

Danke Euch

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 315003

Url: https://administrator.de/forum/vba-zellen-dublizieren-plus-wenn-dann-funktion-315003.html

Ausgedruckt am: 21.04.2025 um 20:04 Uhr

4 Kommentare

Neuester Kommentar

Ich brauche ca. 20 Bedingungen

https://msdn.microsoft.com/de-de/library/cy37t14y.aspx

Select Case Range("A1").Value  
    Case 1
       'do something  
    Case 2
       'do another  
    Case 3
       'again another  
    '...  

    Case Else
        'do something if nothing matches above  
End Select

Regards

Ich bekomme das nicht hin. Kannst Du mir den kompletten Code schicken?

Danke Dir

Zitat von @grasihuepfer:

Ich bekomme das nicht hin. Kannst Du mir den kompletten Code schicken?

What?? You're not able to place the above code in the event instead of the current action ?? I don't know your 20 conditions sorry.

You should learn a bit more VBA instead of copy n pasting everything.

Im Moment funktioniert immer nur das neu hinzugefügte Case, in dem Fall Case 3. Wenn ich Case 4 hinzufüge funktioniert auch wieder nur Case 4. Es kommt keine Fehlermeldung

Private Sub Worksheet_Change(ByVal Target As Range)

Select Case Range("AZ232").Value  

   Case 1

  If Not Intersect(Target, Range("BC222")) Is Nothing Then  
    On Error GoTo Errorhandler
    Application.EnableEvents = False
    Range("BG208").Value = Target.Value  

   ElseIf Not Intersect(Target, Range("BC223")) Is Nothing Then  
   On Error GoTo Errorhandler
   Application.EnableEvents = False
   Range("BH209").Value = Target.Value  
   
     End If

   Case 2
   
  If Not Intersect(Target, Range("BC221")) Is Nothing Then  
   On Error GoTo Errorhandler
   Application.EnableEvents = False
   Range("BG204").Value = Target.Value  
   
    ElseIf Not Intersect(Target, Range("BC222")) Is Nothing Then  
   On Error GoTo Errorhandler
   Application.EnableEvents = False
   Range("BH207").Value = Target.Value  
   
   End If
   
   Case 3
   
     If Not Intersect(Target, Range("BC221")) Is Nothing Then  
   On Error GoTo Errorhandler
   Application.EnableEvents = False
   Range("BG204").Value = Target.Value  
   
    ElseIf Not Intersect(Target, Range("BC222")) Is Nothing Then  
   On Error GoTo Errorhandler
   Application.EnableEvents = False
   Range("BH205").Value = Target.Value  
   
   End If
   
 
Errorhandler:
  Application.EnableEvents = True
  
  End Select
  
  
End Sub