Herbers Excel/VBA-Archiv

Dateien zusammenziehen

• Dateien zusammenziehen von Richard vom 17.08.2004 15:55:20
• AW: Dateien zusammenziehen - von Ulf am 17.08.2004 15:58:34
  • AW: Dateien zusammenziehen - von Richard am 17.08.2004 16:09:51
    • AW: Dateien zusammenziehen - von Ulf am 17.08.2004 17:29:06
      • AW: Dateien zusammenziehen - von andre am 17.08.2004 18:43:27

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"