Worksheet_Change Fehlermeldung

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Dim wb As Workbook Set wb = ThisWorkbook If Not Intersect(Target, Me.Range("A1")) Is Nothing Then Application.EnableEvents = False wb.Worksheets("Tabelle 2").Range("D4").Copy _ Destination:=Me.Range("A2") Application.EnableEvents = True End If End Sub

Hallo Dieter,
danke schon mal. Der Code von dir funktioniert.
Komme mit meinem komplexeren Beispiel trotzdem nicht weiter. Es kommt eine Fehlermeldung ("Die Methode 'Range' für das Objekt '_Worksheet' ist fehlgeschlagen") bei der Zeile mit dem For-Statement ("For Each rngZelle In Range("rngFilterbezeichnungen")"):

Private Sub Worksheet_Change(ByVal Target As Range)
Dim strFilter As String
Dim rngZelle As Range
'Range("rngFilter") entspricht A4 auf Tabelle1
'Range("rngFilterbezeichnungen") A1 bis A20 in Tabelle2
'Range("rngZielzelle") entspricht A12 auf Tabelle1
If Not Intersect(Target, Range("rngFilter")) Is Nothing Then
Application.EnableEvents = False
strFilter = Target.Value
Worksheets("Tabelle2").Select
For Each rngZelle In Range("rngFilterbezeichnungen")
If strFilter = rngZelle Then
'Wert rechts von rngZelle kopieren und nur als Wert einfügen
rngZelle.Offset(0, 1).Select
Selection.Copy
Range("rngZielzelle").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
Next
Application.EnableEvents = True
End If
End Sub

Warum läuft die For-Schleife nicht los?
LG Sebastian

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A1")) Is Nothing Then Worksheets("Tabelle2").Range("D4").Copy Range("B1").PasteSpecial (xlPasteValues) Application.CutCopyMode = 0 End If End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim rngZelle As Range Dim strFilter As String Dim wb As Workbook Dim ws2 As Worksheet 'Range("rngFilter") entspricht A4 auf Tabelle1 'Range("rngFilterbezeichnungen") A1 bis A20 in Tabelle2 'Range("rngZielzelle") entspricht A12 auf Tabelle1 Set wb = ThisWorkbook Set ws2 = wb.Worksheets("Tabelle2") If Not Intersect(Target, Me.Range("rngFilter")) Is Nothing Then strFilter = Target.Value For Each rngZelle In ws2.Range("rngFilterbezeichnungen") If strFilter = rngZelle Then 'Wert rechts von rngZelle kopieren und nur als Wert einfügen rngZelle.Offset(0, 1).Copy Application.EnableEvents = False Me.Range("rngZielzelle").PasteSpecial Paste:=xlPasteValues Application.EnableEvents = True Application.CutCopyMode = xlCut End If Next rngZelle End If End Sub

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread