Microsoft Excel

Herbers Excel/VBA-Archiv

Dateien zusammenziehen

Betrifft: Dateien zusammenziehen von: Richard
Geschrieben am: 17.08.2004 15:55:20

Hallo Leute!

Habe folgendes Problem:

Ich möchte mehrere Dateien, die gleich aufgebaut sind, zusammenziehen, d.h. dass Excel sie einfach untereinander in eine Tabelle schreibt. Dabei sollen aber nur die Daten ab Zeile 2 übertragen werden; Zeile 1 beinhaltet jeweils die Spaltenüberschriften.

Hatte die Frage heute morgen schonmal im Forum und folgendes Makro (Danke hierfür) bekommen, dass aber nicht funktioniert (kann sein, dass ich beim Abschreiben einen Fehler gemacht habe, da die Vorlage eine jpeg-Datei war):

StandardModule: basMain

Sub Zusammenführen()
    Dim wksTarget As Worksheet
    Dim arr As Variant
    Dim iCounter As Integer, iRows As Integer, iRowT As Integer
    Dim sPath As String, sPattern As String
    Application.ScreenUpdating = False
    Workbooks.Add
    Set wksTarget = Worksheets(1)
    Range("A1") = "Datenimport"
    Range("A1").Font.Bold = True
    sPath = ThisWorkbook.Path
    sPattern = "Test*.xls"
    arr = arrAll(sPath, sPattern)
    For iCounter = 1 To UBound(arr)
        Workbooks.Open arr(iCounter)
        iRows = Cells(Rows.Count, 3).End(x1Up).Row
        iRowT = wksTarget.Cells(Rows.Count, 1).End(x1Up).Row + 2
        With wks.Target.Cells(iRowT, 1)
            .Value = arr(iCounter) & ":"
            .Font.Bold = True
        End With
        iRowT = iRowT + 2
        Rows("2:" & iRows).Copy wksTarget.Cells(iRowT, 1)
        Application.DisplayAlerts = False
        ActiveWorkbook.Close savechanges:=False
        Application.DisplayAlerts = True
    Next iCounter
    Columns.AutoFit
End Sub


Function arrAll(sPath As String, sPattern As String) As Variant
    Dim arr()
    Dim iCounter As Integer
    Dim sFile As String
    If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
    sFile = Dir(sPath & sPattern)
    Do While sFile <> ""
        iCounter = iCounter + 1
        ReDim Preserve arr(1 To iCounter)
        arr(iCounter) = sFile
        sFile = Dir()
    Loop
    arrAll = arr
End Function


Excel gibt als Fehlermeldung "Ausserhalb einer Prozedur ungültig" aus und markiert die Zeile StandardModule: basMain

Danke für Eure Hilfe!

Ciao,
Richard
  


Betrifft: AW: Dateien zusammenziehen von: Ulf
Geschrieben am: 17.08.2004 15:58:34

' davor oder einfach löschen, hat ohnehin keine Funktion.

Ulf


  


Betrifft: AW: Dateien zusammenziehen von: Richard
Geschrieben am: 17.08.2004 16:09:51

Hi Ulf,

Danke erstmal!

Funktioniert aber immer noch nicht; wenn ich das Makro starte, kommt eine Excel-Meldung mit der Meldung "400". Es öffnet sich dann eine leere Mappe und in der Ursprungsmappe steht in Zelle A1 "Datenimport".

Kannst Du mir nochmal helfen oder mir eine ganz andere Lösung aufzeigen.

Danke nochmal.

Grüße,
Richard


  


Betrifft: AW: Dateien zusammenziehen von: Ulf
Geschrieben am: 17.08.2004 17:29:06

Sorry, keine Idee.

Ulf


  


Betrifft: AW: Dateien zusammenziehen von: andre
Geschrieben am: 17.08.2004 18:43:27

Hallo Richard,
gehe mal die Schusselfehler durch.
End(x1Up) muss sein End(xlUp) '--(2x)
wks.Target muss sein wksTarget


 

Beiträge aus den Excel-Beispielen zum Thema "Dateien zusammenziehen"