Hallo,
ich möchte mein VBA Code ein wenig anpassen.
Die Tabelle auf die sich meine Frage bezieht ist mit hochgeladen (allerdings ohne Makros..)
Momentan passiert nach dem Doppelklick auf Zelle 3, dass das sheet2 "Materialliste" geöffnet wird, es wird nach dem Wort aus Zelle 3 gefiltert, und ich springe im sheet 2 in die letzte Zeile (ohne Wert) in Zelle 2.
Nun möchte ich, dass so bleibt, aber zusätzlich, wenn ich in Zelle 4 doppelklicke (wo die Symbole sind), soll auch nach dem Wert aus Zelle 3 in sheet 2 gefiltert wird. Es soll zusätzlich auch der Wert aus Zelle 3 mit kopiert wird, wenn ich in die unterste leere Zeile im anderen Sheet 2 springe . Der Wert soll sich dabei in die Zelle 4 (Typ) kopieren.
Wie kann ich das anstellen?
Der Code in VBA lautet:
Danke!
ich möchte mein VBA Code ein wenig anpassen.
Die Tabelle auf die sich meine Frage bezieht ist mit hochgeladen (allerdings ohne Makros..)
Momentan passiert nach dem Doppelklick auf Zelle 3, dass das sheet2 "Materialliste" geöffnet wird, es wird nach dem Wort aus Zelle 3 gefiltert, und ich springe im sheet 2 in die letzte Zeile (ohne Wert) in Zelle 2.
Nun möchte ich, dass so bleibt, aber zusätzlich, wenn ich in Zelle 4 doppelklicke (wo die Symbole sind), soll auch nach dem Wert aus Zelle 3 in sheet 2 gefiltert wird. Es soll zusätzlich auch der Wert aus Zelle 3 mit kopiert wird, wenn ich in die unterste leere Zeile im anderen Sheet 2 springe . Der Wert soll sich dabei in die Zelle 4 (Typ) kopieren.
Wie kann ich das anstellen?
Der Code in VBA lautet:
Visual Basic:
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim strCellVal As String
Dim i As Long
On Error Resume Next
If Intersect(Target.EntireRow, [Übersicht[Typ]]) Is Nothing Then Exit Sub
If Target.Column <> 3 Then Exit Sub
strCellVal = ActiveCell.Value
With Sheet2
.ListObjects(1).Range.AutoFilter 2, Criteria1:=Intersect(Target.EntireRow, [Übersicht[Typ]])
.Activate
i = .ListObjects(1).Range.Columns(1).SpecialCells(xlCellTypeVisible).Count
If i = 1 Then
.ListObjects(1).Range.End(xlDown).Offset(1, 2).Value = strCellVal
End If
.Cells(.Cells(.Rows.Count, 3).End(xlUp).Row + 1, 2).Select
End With
Cancel = True
End Sub
Danke!
Anhänge
Zuletzt bearbeitet von einem Moderator: