Microsoft Excel

Herbers Excel/VBA-Archiv

Masterdatei erstellen

Betrifft: Masterdatei erstellen von: WalterK
Geschrieben am: 23.09.2014 12:55:40

Hallo,

der nachfolgende Code liest aus allen Dateien eines Ordners eine Tabelle aus und kopiert alle Datensätze in eine einzige Tabelle. Funktioniert auch.

Jetzt wollte ich den Code auch mit Excel 2010 benutzen um xlsx-Dateien einzulesen. Deshalb habe ich in der Zeile strDateiname das .xls durch .xlsx ersetzt.

Allerdings kommt der Fehler: Laufzeitfehler 1004: Die Methode Open für das Objekt Workbooks ist fehlgeschlagen und es wird die Zeile Set wkbQuelle = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & strDateiname) gelb markiert.

Option Explicit
Sub zusammenfuegen()
    Dim strDateiname As String
    Dim wksZiel As Worksheet, wkbQuelle As Workbook, wksQuelle As Worksheet
    Dim loLetzte1 As Long
    Dim loLetzte2 As Long
    Dim inLetzte As Integer
    Application.ScreenUpdating = False
    strDateiname = Dir(ThisWorkbook.Path & "\*.xls")
    Set wksZiel = ThisWorkbook.Worksheets("Tabelle1")
    Do While strDateiname <> ""
        If strDateiname <> ThisWorkbook.Name Then
            Set wkbQuelle = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & strDateiname)
            Set wksQuelle = ActiveSheet 'ggf. = wkbQuelle.Worksheets(1)
            
            loLetzte1 = wksZiel.UsedRange.SpecialCells(xlCellTypeLastCell).Row
            With wksQuelle
              loLetzte2 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
              inLetzte = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
              .Range(.Cells(3, 1), .Cells(loLetzte2, inLetzte)).Copy _
                    Destination:=wksZiel.Cells(loLetzte1 + 1, 1)
            End With
            
            wkbQuelle.Close True
        End If
        strDateiname = Dir
    Loop
    Set wkbQuelle = Nothing: Set wksQuelle = Nothing: Set wksZiel = Nothing
    Application.ScreenUpdating = True
End Sub
Danke für die Hilfe und Servus, Walter

  

Betrifft: AW: Masterdatei erstellen von: fcs
Geschrieben am: 23.09.2014 13:23:53

Hallo Walter,

ich hab dein Makro in der folgenden Form getestet.

Sub zusammenfuegen()
    Dim strDateiname As String
    Dim wksZiel As Worksheet, wkbQuelle As Workbook, wksQuelle As Worksheet
    Dim loLetzte1 As Long
    Dim loLetzte2 As Long
    Dim inLetzte As Integer
    Application.ScreenUpdating = False
    strDateiname = Dir(ThisWorkbook.Path & "\*.xlsx")  '###angepasst###
    Set wksZiel = ThisWorkbook.Worksheets("Tabelle1")
    Do While strDateiname <> ""
        If strDateiname <> ThisWorkbook.Name Then
            Set wkbQuelle = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & strDateiname)
            Set wksQuelle = ActiveSheet 'ggf. = wkbQuelle.Worksheets(1)
            
            loLetzte1 = wksZiel.UsedRange.SpecialCells(xlCellTypeLastCell).Row
            With wksQuelle
              loLetzte2 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
              inLetzte = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
              .Range(.Cells(3, 1), .Cells(loLetzte2, inLetzte)).Copy _
                    Destination:=wksZiel.Cells(loLetzte1 + 1, 1)
            End With
            
            wkbQuelle.Close True
        End If
        strDateiname = Dir
    Loop
    Set wkbQuelle = Nothing: Set wksQuelle = Nothing: Set wksZiel = Nothing
    Application.ScreenUpdating = True
End Sub

Es funktioniert.

Hast du etwas außergewöhnlich Dateinamen, mit denen der Dir-Befehl nicht klarkommt?
Was für Werte werden denn für strDateiname angezeigt?

Gruß
Franz


  

Betrifft: AW: Masterdatei erstellen von: WalterK
Geschrieben am: 23.09.2014 15:30:34

Hallo Franz,

danke für's Nachschauen.

Es handelt sich um 21 Dateien und ich habe jetzt alle geöffnet. Bei zweien kam der Hinweis, dass nicht lesbarer Inhalt vorhanden ist. Diese 2 Dateien habe ich neu abgespeichert und jetzt läuft der Code durch. Problem ist also behoben.

Danke und Servus, Walter


 

Beiträge aus den Excel-Beispielen zum Thema "Masterdatei erstellen"