Autofilter Array - komm nicht weiter!!!
27.12.2016 15:18:50
Nilo
ich habe ein Problem mit einem Autofilter Array.
Wenn ich unten stehenden VBA umstelle auf:
Kriterium = Acell.Value
Criteria1:=Kriterium
Dann funktioniert alles wie es soll.
Ich möchte aber gerne ein paar mehr Kriterien vergeben und habe es so versucht.
Geht irgendwie nicht, das Bild wird zwar nach wie vor eingeblendet, nur ohne Inhalt!!!
Danke schon mal und Gruß
Nilo
Sub ListenFilterAllin()
Dim ZielMappe As Workbook
Dim QuellMappe As Workbook
Dim ListenEnde As Long
Dim Kriterium, Kriterium1, Kriterium2 As String
Dim Acell As Range
Application.ScreenUpdating = False
Set ZielMappe = ActiveWorkbook
Set QuellMappe = Workbooks("Daten.xlsm")
Set Acell = ActiveCell 'Cells(3, 1)
ListenEnde = QuellMappe.Worksheets("MMPO").Cells(1, 1).End(xlDown).Row
Kriterium = Range("G18").Value 'Acell.Value
Kriterium1 = Range("H18").Value
Kriterium2 = Range("I18").Value
Workbooks("Daten.xlsm").Worksheets("MMPO").Activate
Range("A1").Activate
ZielMappe.RefreshAll
QuellMappe.Activate
Worksheets("MMPO").Range(Cells(1, 1), Cells(ListenEnde, 11)).AutoFilter Field:=9, Criteria1: _
=Array(Kriterium, Kriterium2, Kriterium3), Operator:=xlFilterValues
Worksheets("MMPO").Range(Cells(1, 1), Cells(Cells(1, 1).End(xlDown).Row, 11)).CopyPicture _
Appearance:=xlScreen, Format:=xlPicture 'CopyPicturexlScreen , Format:=xlPicture
ZielMappe.Activate
Worksheets("Data").Paste Destination:=Tabelle16.Cells(ActiveCell.Row, 3)
Application.CutCopyMode = False
QuellMappe.Activate
Worksheets("MMPO").Range(Cells(1, 1), Cells(ListenEnde, 9)).AutoFilter
ZielMappe.Activate
Set ZielMappe = Nothing
Set QuellMappe = Nothing
Set Acell = Nothing
Application.ScreenUpdating = True
End Sub