zellen aus verschiedenen dateien auslesen
16.06.2008 16:23:23
Raphael
gerne möchte ich aus diversen exceldateien verschiedene zellen auslesen. ich habe dies mal mit dem folgenden code funktioniert. dieser funktioniert auch, problem habe ich aber jetzt, da in den einzelnen dateien die gewünschten zellen nicht im erste sheet ist sondern in einem andern mit dem namen "verschiedeneinfos"
besten dank für eure hilfe
raphi
mein code:
Sub DatenEinlesen()
' Daten aus mehreren Dateien in eine neue Datei einlesen
Dim wkbNeu As Workbook, wksDataSheet As Worksheet, Pfad As String
Dim Datei As Variant, I As Integer, J As Integer, Zellen As Variant, Titel As Variant
Pfad = "Y:\AusDateiAuslesen\Daten" ' Pfad der Daten-Dateien anpassen
'Spaltentitel anpassen bzw. ergänzen
Titel = Array("Namen", "Spezialist", "Berater")
'Zellen die ausgelesen werden sollen. Liste anpassen bzw. ergänzen
'Zellen in der Reihenfolge der Spaltentitel angeben
Zellen = Array("F8", "F26", "F28")
' Neue Arbeitsmappe öffen , alternativ hier eine leere Musterdatei öffnen
Workbooks.Add Template:="Arbeitsmappe"
Set wkbNeu = ActiveWorkbook
' Daten-Dateien suchen
Datei = Dir(Pfad & "\eingabe*.XLS") ' Suchstring für EXCEL-Dateien anpasssen
' Spaltentitel setzen, kann bei Musterdatei entfallen
For J = 0 To UBound(Titel)
wkbNeu.Sheets(1).Cells(1, J + 1) = Titel(J)
Next J
I = 2 'Startzeile für Daten in neuer Datei
Do Until Datei = ""
' Daten-Datei öffnen
Application.ScreenUpdating = False
Workbooks.Open Pfad & "\" & Datei
Set wksDataSheet = ActiveWorkbook.Sheets(1)
' Daten in neue Datei übertragen
For J = 0 To UBound(Zellen)
wkbNeu.Sheets(1).Cells(I, J + 1) = wksDataSheet.Range(Zellen(J))
Next J
' Daten-Datei wieder schließen
ActiveWorkbook.Close False
Datei = Dir
I = I + 1
Application.ScreenUpdating = True
Loop
wkbNeu.Activate
' Neue Arbeitsmappe speichern
Application.Dialogs(xlDialogSaveAs).Show
End Sub