chris.06
Goto Top

Excel: Script zum Suchen eines Begriffs in mehreren Excel Dateien und übertragen mehrerer Zeilen in aktueller Datei

Guten Tag zusammen,

Also ich möchte gerne einen Suchbegriff hier "Projektname" in mehreren Excel Dateien in der Spalte "Target" suchen und dann wenn er gefunden wurde.

Soll er in der Reihe wo er "Projektname" gefunden hat Zeilen A-X in die Tabelle des Script ausführenden Datei schreiben.
Bis keine Zeilen mit dem "Projektname" gefunden werden können, in allen im Ordner befindlichen Excel Dateien.

Ich habe bisher die Suche nach dem "Projektname" im Script weis aber nicht, wie ich die Zeilen in der Reihe in die Tabelle rüber kopieren kann.

Sub SearchAndCopyData()
    'Variablen  
    Dim fso As Object, strFind As String, wsTarget As Worksheet, file As Object, sh As Worksheet, rngCol As Range, c As Range, firstAddress As String, dblKosten As String, strFolder As String, strHeader As Variant
    
    'Ordner in dem sich die xlsx-Dateien befinden (im Beispiel der aktuelle Pfad in dem sich diese Mappe befindet)  
    strFolder = "Projekt Pfad"  
    
    'Objekte  
    Set fso = CreateObject("Scripting.FileSystemObject")  
    
    'Sheet festlegen in das die Daten kopiert werden  
    Set wsTarget = Sheets(1)
    
    'Eingabeaufforderung für die Nummer  
    strFind = InputBox("Bitte geben sie den Projektnamen an:", "Projektname suchen", "Projekt123")  
    If strFind <> "" Then  
        'Screenflicker und Dialoge unterdrücken  
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        
        'Ausgabebereich löschen  
        wsTarget.Range("A2:X10000").Clear  
        
        'Für jede Datei im Ordner ...  
        For Each file In fso.GetFolder(strFolder).Files
            'Wenn es eine 'xlsx' Datei ist  
            If LCase(fso.GetExtensionName(file.Name)) = "xlsx" Then  
                'Mappe öffnen  
                Set wbSearch = GetObject(file.Path)
                ' Alle Sheets der Datei durchsuchen  
                For Each sh In wbSearch.Sheets
                    With sh.UsedRange
                        'Suche Spaltenüberschrift 'Target'  
                        For Each strHeader In Array("Target")  
                            Set rngCol = sh.UsedRange.Find(strHeader, LookIn:=xlValues, LookAt:=xlWhole)
                            If Not rngCol Is Nothing Then Exit For
                        Next
                        'Wurde eine der Spalten gefunden, suche Projektname  
                        If Not rngCol Is Nothing Then
                            Set c = .Find(strFind, LookIn:=xlValues, LookAt:=xlWhole)
                            If Not c Is Nothing Then
                                firstAddress = c.Address

Da ich mich nicht so gut mit der Programmierung auskenne hab ich mir den code bisher aus dem Forum zusammengesucht.

Vielen dank im Voraus für die hilfe ich hoffe es ist alles soweit verständlich

Chris

Content-Key: 4535430238

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

Printed on: May 2, 2024 at 01:05 o'clock

Mitglied: 4400667902
4400667902 Nov 07, 2022 updated at 14:34:50 (UTC)
Goto Top