Clever-Excel-Forum

Hallo,

ich will in einem Verzeichnis aus mehreren Excel-Dateien bestimmte Zeilen auslesen.
Ich habe ein Beispiel gefunden und kann aber nur aus meinem Tabellenblatt
"Yieldverlauf über 2 Monate" die Zeile 2 oder Zeile 3 auslesen.
Wie kann ich beide Zeilen (2 und 3) auslesen ?

Wenn ich in der Zeile:

arr(z, x) = "='" & sSourcePath & "\[" & oFile.Name & "]" & sSourceSheet & "'!$" & i & "$2" 'Array füllen

den Wert $2 oder $3 eintrage wird immer nur die zweite oder dritte Zeile ausgelesen.

Den Code und und zwei Dateien hänge ich an.

Kann mir jemand einen Tip geben ?

Danke und Gruß
Günti

Code:
Sub Zusammenfassen_Excel_Dateien()

Dim sSourcePath As String, sSourceSheet As String

Dim arr, z As Integer, i, x As Integer, oFile, fso

Dim wbges As Workbook, wsziel As Worksheet

sSourcePath = "C:\PG500\Inf-Files" ' Pfad

sSourceSheet = "Yieldverlauf über 2 Monate" ' Tabellenname aus der Quelldatei

Set wbges = ActiveWorkbook 'aktuelle Datei, Zieldatei

Set wsziel = ActiveWorkbook.ActiveSheet 'aktuelles Tabellenblatt der Zieldatei

Set fso = CreateObject("Scripting.FileSystemObject")

Application.ScreenUpdating = False 'während der folgenden Aktionen Bildschirm einfrieren

ReDim arr(fso.GetFolder(sSourcePath).Files.Count, 10) 'Array dimensionieren

For Each oFile In fso.GetFolder(sSourcePath).Files 'alle Quelldateien im Verzeichnis durchlaufen

If LCase(fso.getextensionname(oFile.Name)) = "xlsx" Then 'nur xlsx-Dateien bearbeiten

For Each i In Array("a", "b", "c")

arr(z, x) = "='" & sSourcePath & "\[" & oFile.Name & "]" & sSourceSheet & "'!$" & i & "$2" 'Array füllen

x = x + 1 'Laufende Spaltennummer im Array

Next

x = 0: z = z + 1

End If

Next 'Datei

Application.ScreenUpdating = True 'Bildschirmanzeige wiederauftauen

With wsziel

.Range(.Cells(2, 1), .Cells(UBound(arr) + 2, 11)) = arr 'Array ausgeben

  With .Range(.Cells(2, 1), .Cells(UBound(arr) + 2, 11))

  .Value = .Value

  End With

End With

'Anpassung der Spaltenbreite

    Call ActiveSheet.Columns.AutoFit

'Zahlenformat festlegen

    Range("B:B").NumberFormat = "#,##0.00"

wbges.Save 'ZielDatei speichern

MsgBox "Fertig"

End Sub

Hallo Günti,

ok, ... "falscher Fehler" von mir , sorry

Hallöchen,

da wäre die Frage, wie die Daten im Ziel angeordnet werden sollen.
Eine Variante wäre, eine 3. Schleife um die beiden anderen zu bauen, und darin die 2 und die 3 zu wechseln.
Eine andere Variante wäre, in der bestehenden Schleife nach x=x+1 die 3. Zeile zu übernehmen und dann x nochmal um 1 zu erhöhen.

Da das Array dann doppelt so groß ist, müsstest Du weiter oben den Wert beim Redim auch verdoppeln und unten beim Eintrag der Werte auch erhöhen.

Hallo,

das mit dem Array ist glaube ich zu komplizert für nur 6 Zellen.

In der Quelle sind einfach 2 Zeilen mit jeweils 3 Zellen auszulesen.
Das Blatt heißt in jeder Quelldatei immer gleich (Yieldverlauf über 2 Monate)
und die Zellen sind immer A2 bis C3.

Im Ziel müssen die Zellen in der gleichen Form wie in der Quelle
fortlaufend aufgelistet werden.
Erste Excel Datei: A2 bis C3
Zweite Excel Datei: A5 bis C6
Dritte Excel Datei: A8 bis C9
usw.

Kann ich das vielleicht nicht einfacher mit 6 Variablen machen
und das Array weglassen ?

Danke und Gruß
Günti

Hallo Günti,

Du kannst natürlich auch ohne Array arbeiten und die Formeln gleich in die Zellen eintragen. Allerdings ist die Variante über ein Array in der Regel schneller und Du hast damit, wenn's wirklich darauf ankommt, auch gleich mehr Erfahrung damit.

Hallo,

ich habe die Lösung jetzt gefunden.
Hier ist der Code:

Code:
Sub prcForm()

  Dim lngC As Long, lngA As Long

  Dim strPath As String

  Dim strDatei As String

  Dim vntZellAdressen As Variant

  lngC = 6

  vntZellAdressen = Array("A2", "B2", "C2", "A3", "B3", "C3")

  strPath = "C:\PG500\Inf-Files\"

  strDatei = Dir(strPath & "*.xlsx")

  Do While strDatei <> ""

     Workbooks.Open (strPath & strDatei)

     For lngA = 0 To UBound(vntZellAdressen)

        ActiveWorkbook.Worksheets(3).Range(vntZellAdressen(lngA)).Copy ThisWorkbook.Worksheets(1).Cells(lngC, lngA + 1)

     Next lngA

    lngC = lngC + 1

     ActiveWorkbook.Close False

     strDatei = Dir

  Loop

   'Anpassung der Spaltenbreite

    Call ActiveSheet.Columns.AutoFit

End Sub

Trotzdem vielen Dank für die Mühe.

Gruß
Günti

Günti

Käpt'n Blaubär

schauan

Günti

schauan

Günti