Spezialfilter - 2 Arbeitsmappen

18/09/2008 - 11:16 von dari | Report spam
Guten Tach,

ich habe versucht das unten abgebildete Makro abzuàndern, so dass die
Datenquelle in einer eigenen Arbeitsmappe (auf einem anderen Laufwerk)
liegt. Leider war mein Unterfangen erfolglos. Auch der Versuch die
Filterung über eine Schaltflàche auszulösen war nicht möglich.

Hàtte jemand dazu eine Ieee?

Danke schonmal,

Gruß
Dari

******************************************************************

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws2 As Worksheet
Dim rngList As Range
Dim rngCriteria As Range
Set ws2 = Worksheets("Tabelle2")
Set rngCriteria = Range("B3:H6")
Set rngList = ws2.Range("A2:G" & 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:G10"), _
Unique:=False
End If
Set ws2 = Nothing
Set rngList = Nothing
Set rngCriteria = Nothing
End Sub

*******************************************************
 

Lesen sie die antworten

#1 stefan onken
18/09/2008 - 12:26 | Warnen spam
Tach auch ;)

du musst die Codezeile
Set ws2 = Worksheets("Tabelle2")
mit den Dateinamen der Mappe erweitern, etwa
Set ws2 = Workbooks("Mappe1.xls").Worksheets("Tabelle2")

wen die Mappe nicht geöffnet ist, muss sie (per Code) geöffnet werden
Workbooks.Open

Um das Makro für einen Button verfügbar zu machen, kannst du dieses
tun:
gehe im VBA-Editor auf Einfügen/Modul
tippe im großen Codefenster die Codehülse ein (also zB Sub Filtern).
zwischen Sub und dem automatisch eingefügten End Sub kommt dein Code
(ohne die Private und End Sub-Zeilen)

um das Makro beim Worksheet_Change weiterhin verfügbar zu haben:

Private Sub Worksheet_Change(ByVal Target As Range)
Filtern
End Sub

für einen button ist das dann ebenso.

Gruß
stefan


On 18 Sep., 11:16, dari wrote:
Guten Tach,

ich habe versucht das unten abgebildete Makro abzuàndern, so dass die
Datenquelle in einer eigenen Arbeitsmappe (auf einem anderen Laufwerk)
liegt. Leider war mein Unterfangen erfolglos. Auch der Versuch die
Filterung über eine Schaltflàche auszulösen war nicht möglich.

Hàtte jemand dazu eine Ieee?

Danke schonmal,

Gruß
Dari

******************************************************************

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim ws2 As Worksheet
   Dim rngList As Range
   Dim rngCriteria As Range
   Set ws2 = Worksheets("Tabelle2")
   Set rngCriteria = Range("B3:H6")
   Set rngList = ws2.Range("A2:G" & 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:G10"), _
         Unique:=False
   End If
   Set ws2 = Nothing
   Set rngList = Nothing
   Set rngCriteria = Nothing
End Sub

*******************************************************

Ähnliche fragen