Excel VBA enthält
Guten Tag
Ich bin ganz neu in diesem Forum und hätte eine Frage. Wie kann ich bei diesem bestehenden Code, wie beim Textfilter enthält für die Auswahl benutzen.
Gerne möchte ich im meinen Excel nach allen Wörtern die z.Bsp. Vase enthalten, dann Blumenvase etc. ausgibt.
Des weiteren sollten die Daten in der Zelle E11 nach H11 kopiert werden.
Kann mir da bitte jemand helfen.
Besten Dank im Voraus
Angels
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws2 As Worksheet
Dim rngList As Range
Dim rngCriteria As Range
' Kriterienbereich
Set ws2 = Worksheets("Basis Konto")
Set rngCriteria = Range("B3:E4")
Set rngList = ws2.Range("A1:F" & ws2.UsedRange.Rows.Count)
' Filterung ausführen
If Not (Application.Intersect(rngCriteria, Target) Is Nothing) Then
rngList.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=rngCriteria, _
CopyToRange:=Range("B10:E10"), _
Unique:=False
End If
' Kriterienbereich
Set ws2 = Worksheets("Basis")
Set rngCriteria = Range("H3:M4")
Set rngList = ws2.Range("A1:F" & ws2.UsedRange.Rows.Count)
' Filterung ausführen
If Not (Application.Intersect(rngCriteria, Target) Is Nothing) Then
rngList.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=rngCriteria, _
CopyToRange:=Range("H10:M10"), _
Unique:=False
End If
Set ws2 = Nothing
Set rngList = Nothing
Set rngCriteria = Nothing
End Sub
Ich bin ganz neu in diesem Forum und hätte eine Frage. Wie kann ich bei diesem bestehenden Code, wie beim Textfilter enthält für die Auswahl benutzen.
Gerne möchte ich im meinen Excel nach allen Wörtern die z.Bsp. Vase enthalten, dann Blumenvase etc. ausgibt.
Des weiteren sollten die Daten in der Zelle E11 nach H11 kopiert werden.
Kann mir da bitte jemand helfen.
Besten Dank im Voraus
Angels
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws2 As Worksheet
Dim rngList As Range
Dim rngCriteria As Range
' Kriterienbereich
Set ws2 = Worksheets("Basis Konto")
Set rngCriteria = Range("B3:E4")
Set rngList = ws2.Range("A1:F" & ws2.UsedRange.Rows.Count)
' Filterung ausführen
If Not (Application.Intersect(rngCriteria, Target) Is Nothing) Then
rngList.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=rngCriteria, _
CopyToRange:=Range("B10:E10"), _
Unique:=False
End If
' Kriterienbereich
Set ws2 = Worksheets("Basis")
Set rngCriteria = Range("H3:M4")
Set rngList = ws2.Range("A1:F" & ws2.UsedRange.Rows.Count)
' Filterung ausführen
If Not (Application.Intersect(rngCriteria, Target) Is Nothing) Then
rngList.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=rngCriteria, _
CopyToRange:=Range("H10:M10"), _
Unique:=False
End If
Set ws2 = Nothing
Set rngList = Nothing
Set rngCriteria = Nothing
End Sub
Please also mark the comments that contributed to the solution of the article
Content-Key: 248817
Url: https://administrator.de/contentid/248817
Printed on: April 24, 2024 at 01:04 o'clock