AW: Mehrere Reports zusammenfügen
15.01.2008 19:01:38
fcs
Hallo liebe Helfer,
bin mir nicht sicher, ob ich hier posten darf/soll, aber mein Problem ähnelt dem von Sven:
Datensätze aus vielen Arbeitsmappen zusammenfassen
Jeden Tag wird im Nachtlauf nach einem Stundenübertrag von Datenbank A zu Datenbank B ein Logfile generiert, das dann automatisch als Excel 2010-Datei zur Verfügung steht.
Da ich einen Fehler in Datenbank B (beginnnend Anfang Juli) identifiziert habe, müsste ich sämtliche Excel-Dateien einzeln filtern, um die Datensätze mit einer bestimmten Meldung herauszuziehen, in einer Ergebnis-Datei zusammenzufassen und dann auszuwerten. (die Original-Textdateien sind leider nicht mehr verfügbar, aber der Aufbau Excel ist immer identisch, Anzahl der DS unterschiedlich -zwischen 500 und 800)
Also: Ich suche alle Datensätze (komplette Zeilen) in den einzelnen Dateien, wenn in der Spalte "Bemerkungen" der Text "FA" steht, und möchte diese DS in einer separaten Datei haben.
Der Dateiname ist so aufgebaut: Datum_automat. generierte Nr.xlsx
Beispiel:
14092014_564389.xlsx
15092014_943285.xlsx
Wenn es hilft, könnte ich alle Dateien kopieren, in einen neuen Ordner kopieren und die Kopien evt. fortlaufend nummerieren.
Von VBA habe ich so gut wie keine Ahnung.
Könnt ihr mir helfen?
habe im Archiv nachgesehen, vielleicht könnte man das anpassen (ich muss es nur noch verstehen):
Betrifft: AW: Zellen aus n-Zeilen und n-Dateien kopieren und
Sub DatenSammeln()
Dim wbNeu As Workbook, wksNeu As Worksheet,
lZeileneu As Long
Dim wbQuelle As Workbook, wksQuelle As Worksheet,
strQuelle, i As Integer
Dim strVerzeichnis, VerzAktuell As String,
DateiNr As Integer
'Verzeichnis durch Wahl einer Datei wählen
VerzAktuell = VBA.CurDir
strVerzeichnis = Application.GetOpenFilename
(Filefilter:="Exceldateien(*.xls),*.xls", _
Title:="Bitte Datei im gewünschten
Verzeichnis wählen und öffnen")
If strVerzeichnis = False Then Exit Sub
strVerzeichnis = VBA.CurDir
VBA.ChDir VerzAktuell
With Application.FileSearch
.LookIn = strVerzeichnis
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
.Execute
Set wbNeu = Workbooks.Add
(Template:=xlWBATWorksheet)
Set wksNeu = wbNeu.Worksheets(1)
lZeileneu = 1
DateiNr = 1
Application.ScreenUpdating = False
For Each strQuelle In .FoundFiles
Application.StatusBar =
"Datei Nummer " & DateiNr & " von " _
& .FoundFiles.Count
Set wbQuelle = Workbooks.Open
(FileName:=strQuelle, ReadOnly:=True)
'Alle Tabellenblätter in Quelle abarbeiten
For i = 1 To wbQuelle.Worksheets.Count
Set wksQuelle = wbQuelle.Worksheets(i)
wksNeu.Cells(lZeileneu, 1) = wbQuelle.FullName
wksNeu.Cells(lZeileneu, 2) = wksQuelle.Name
With wksQuelle
.Range(.Cells(2, 1), .Cells(2, 10)).
Copy 'bereich A2:J2
wksNeu.Cells(lZeileneu,
3).PasteSpecial Paste:=xlFormats 'Zell-Formate
wksNeu.Cells(lZeileneu,
3).PasteSpecial Paste:=xlValues 'Zellewerte
'ggf. Code für weitere Zellbereiche ergänzen
End With
lZeileneu = lZeileneu + 1
Next i
wbQuelle.Close savechanges:=False
DateiNr = DateiNr + 1
Next strQuelle
End With
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub
(musste Zeilenumbrüche einfügen)
Vielen Dank für eure Hilfe