Excel Dateien nach einen Begriff Filtern und in eine andere Datei übertragen

Schönen guten Morgen zusammen,

Ich müsste für eine Arbeit mehrere Datein in Excel auslesen und nach einem Bestimmten Begriff filtern.

Also z.B die Tabellen sind alle gleich aufgebaut Datum bereich usw. und in Spalte G müsste dann z.B nach dem Wort Technik gefiltert werden, damit nur Zeilen auftauchen mit dem Begriff in der Spalte.

Und die Zeilen sollen dann Seperat in eine andere Excel Datei eingefügt werden.

Und da das viele Datein sind die ich sonst per Hand alles copy & pasten müsste, dachte ich das ich das mit einem Makro machen kann, aber das klappt jetzt nicht so wie geplannt.

Hat da hier vielleicht jemand mehr Erfahrung und kann mir helfen ?

Benutzen tue ich Excel aus Office 365 :D

Vielen Dank im voraus

Chris

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 4533138735

Url: https://administrator.de/contentid/4533138735

Ausgedruckt am: 24.11.2024 um 13:11 Uhr

8 Kommentare

Neuester Kommentar

VBS zum kopieren ganzer Zeilen - Auswahl nach wertebereich

Danke den Betrag habe ich bereits gelesen :D
Aber in meinem Fall sind die "Quelle" eine komplett andere Datei und das "Ziel" ist auch nochmal eine andere excel Datei. Daher müsste ich die Daten erst aus der "Quellen" datei in die "ziel Datei bekommen :D

Na und, ist doch nur ein anderes Workbook Objekt, und das lässt sich ja leicht öffnen mit
Workbooks.Open und drauf zugreifen, also kein großer Unterschied...
https://learn.microsoft.com/de-de/office/vba/api/excel.workbooks.open

Gibts hier aber auch
Excel 2013 Suche nach einem Wert in mehreren Excel-Dateien und Ausgabe weiterer Werte zum Suchergebnis incl. Angabe der Quelldatei mittel Makro

Möchtest du die gefilterten Zeilen ("Technik") jeweils in eine neue Datei speichern oder alle Zeilen in eine Datei zusammenführen?

Ich möchte das alle datein die gefilterten Zeilen ("Technik") in die script ausführende Datei bzw Tabelle kopiert werden.

Zitat von @Chris.06:
Ich möchte das alle datein die gefilterten Zeilen ("Technik") in die script ausführende Datei bzw Tabelle kopiert werden.

Dann kannst du die Daten importieren: Registerkarte Daten -> Daten abrufen -> Aus Datei -> Aus Ordner. Dann wählst du den Ordner aus, indem sich die Dateien befinden und sagst im nächsten Dialogfeld Daten kombinieren und transformieren, bestätigst den folgenden Dialog.
Nun bist du im Power Query-Editor. Hier klickst du auf den kleinen Pfeil neben der Spalte G und setzt deinen Textfilter. Schließen und laden - fertig. Wenn sich die Ausgangsdateien ändern, kannst du sogar alles aktualisieren.

Ja das habe ich sogar schon gemacht :D Aber bei über 100 Datein dauert das leider. Deshalb wollte ich das gerne mit einem Script versuchen

Wie müsste ich das umschreiben damit er nur den Suchbegriff in der Zeile "F2" nehmen soll,
danach in den den anderen datein filtern soll und Zeilen in denen der Suchbegriff zutrifft,

dann die komplette Zeile von z.B A2 bis W2 in das Aktuelle Sheet kopieren soll wo das Script läuft ?

Sub SearchInSheets()
    Dim strPath As String, ws As Worksheet, cFile As String, rngSearch As Range, rngSource As Range, intFoundCount As Integer
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    'Pfad in dem die Dateien liegen (Default ist hier der Pfad in dem diese Datei liegt)  
    strPath = "Datenpfad hier"  
    'Alle *.xlsx Dateien suchen  
    cFile = Dir(strPath & "\*.xlsx")  
    With ActiveSheet
        'Suchbegriff Range ermitteln  
        Set rngSource = .Range("F2" & .Cells(Rows.Count, "F").End(xlUp).Row)  
        ' Lösche vorhergehende Suchergebnisse  
        rngSource.Offset(0, 1).Resize(, 2).ClearContents
        'Jede *.xlsx Datei durchsuchen  
        Do While cFile <> ""  
            'Datei öffnen und erstes Sheet referenzieren  
            Set ws = GetObject(strPath & "\" & cFile).Sheets(1)  
            ' Definiere belegten Suchbereich Spalte C  
            Set rngSearch = ws.Range("F2:F" & ws.Cells(Rows.Count, "F").End(xlUp).Row)  
            ' Suche im aktuellen Sheet alle ungefundenen Suchbegriffe  
            For Each cell In rngSource
                If cell.Offset(0, 1).Value = "" Then  
                    ' Suche starten  
                    Set f = rngSearch.Find(cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
                    ' War Suche erfolgreich setze die Informationen neben den Suchbegriff  
                    If Not f Is Nothing Then
                        cell.Offset(0, 1).Resize(1, 2).Value = f.Offset(0, -2).Resize(1, 2).Value
                        intFoundCount = intFoundCount + 1
                    End If
                End If
            Next
            'Datei wieder schließen  
            ws.Parent.Close False
            ' Alle Suchbegriffe wurden gefunden => beende Schleife  
            If intSourceCount = rngSource.Rows.Count Then Exit Do
            'nächste Datei holen  
            cFile = Dir
        Loop
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    ' Fertig  
    MsgBox "Suche beendet", vbInformation  
End Sub