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, weiß aber nicht, wie ich die Zeilen in der Reihe in die Tabelle rüberkopieren 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
der VBAnoob
|