Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Durchsuchen einer gesamten Arbeitsmappe
#11
Hallo,

(13.11.2016, 21:10)schadre schrieb: In der Beispieldatei funktioniert das spitzenmäßig.
Hatte versuch das für meine Arbeitsmappe abzuändern. Leider ohne Erfolg.
In meiner Originaldatei habe ich den Bereich in den Daten stehen von A1 bis N600.

so ist das eben, wenn die "Beispieldatei" nichts mit der Arbeitsdatei zu tun hat.
Hier siehst Du, wie der Spezialfilter funktioniert.

Gruß Uwe
[-] Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:
  • schadre
Antworten Top
#12
Hallo,

ich habe es mal für die Spalten A:N vorbereitet.
Wichtig ist, dass die Spaltenüberschriften des Kriterienbereiches identisch mit denen des Quellbereiches sein müssen!
Private Sub Worksheet_Activate()
 Dim oWs As Worksheet, rngZ As Range
 Range("D2,E3,F4,G5,H6,I7,J8,K9,L10,M11,N12").Value = "<" & CLng(Date)
 Set rngZ = Range("A15:N15")
 rngZ.CurrentRegion.Offset(1) = ""
 For Each oWs In Worksheets
   If oWs.Name <> Me.Name Then
     If oWs.Cells(1).CurrentRegion.Rows.Count > 1 Then
       oWs.Columns("A:N").AdvancedFilter Action:=xlFilterCopy, _
         CriteriaRange:=Range("A1:N12"), CopyToRange:=rngZ, Unique:=False
       rngZ.Delete xlUp
       Set rngZ = Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 14)
     End If
   End If
 Next oWs
End Sub
Gruß Uwe


Angehängte Dateien
.xlsm   Test_Kuwer_2.xlsm (Größe: 22,04 KB / Downloads: 2)
[-] Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:
  • schadre
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste