Makro versagt bei xlsx Dateien

Hallo
Der folgende Code funktioniert beim Auslesen aus xls Dateien reibungslos aber nicht aus xlsx Dateien. Wer hat mir einen Tipp, was es anzupassen gilt?
Vielen Dank für die Unterstützung.


'die Daten jeder Datei werden in eine eigene Zeile geschrieben
' Variablen deklarieren
Dim datei As String
Dim pfad As String
Dim i As Integer
i = 1
' Quellordner wird festgelegt
pfad = "P:\Sales-Marketing Bräcker\7_Product Management\7.4_Products\13000_Ringe\Ringuntersuchungen\"
' Dateien des Quellordners ermitteln
datei = Dir(pfad)
' Schleife, um jede Datei auszulesen
Do While datei  ""
' Datei öffnen (Pfad wird aus den Variablen pfad und datei zusammengesetzt
Workbooks.Open Filename:=pfad & datei
' Zählvariable für die Zeilen (je Datei eine neue Zeile)
i = i + 1
' Cells wird wie folgt verwendet Cells(Zeilennummer, Spaltennummer)
' Wenn das Makro in der Zieldatei steht, kann die Datei ThisWorkbook genannt werden.
ThisWorkbook.Sheets("Tabelle1").Cells(i, 1) = ActiveWorkbook.Sheets("Main").Cells(2, _
10)
ThisWorkbook.Sheets("Tabelle1").Cells(i, 2) = ActiveWorkbook.Sheets("Main").Cells(1, _
9)
ThisWorkbook.Sheets("Tabelle1").Cells(i, 3) = ActiveWorkbook.Sheets("Main").Cells(19, _
6)
ThisWorkbook.Sheets("Tabelle1").Cells(i, 4) = ActiveWorkbook.Sheets("Main").Cells(19, _
13)
ThisWorkbook.Sheets("Tabelle1").Cells(i, 5) = ActiveWorkbook.Sheets("Main").Cells(19, _
12)
ThisWorkbook.Sheets("Tabelle1").Cells(i, 6) = ActiveWorkbook.Sheets("Main").Cells(21, _
13)
ThisWorkbook.Sheets("Tabelle1").Cells(i, 7) = ActiveWorkbook.Sheets("Main").Cells(20, _
12)
ThisWorkbook.Sheets("Tabelle1").Cells(i, 8) = ActiveWorkbook.Sheets("Main").Cells(23, _
13)
ThisWorkbook.Sheets("Tabelle1").Cells(i, 9) = ActiveWorkbook.Sheets("Main").Cells(21, _
12)
ThisWorkbook.Sheets("Tabelle1").Cells(i, 10) = ActiveWorkbook.Sheets("Main").Cells(25, _
6)
ThisWorkbook.Sheets("Tabelle1").Cells(i, 11) = ActiveWorkbook.Sheets("Main").Cells(22, _
6)
ThisWorkbook.Sheets("Tabelle1").Cells(i, 12) = ActiveWorkbook.Sheets("Main").Cells(15, _
6)
ThisWorkbook.Sheets("Tabelle1").Cells(i, 13) = ActiveWorkbook.Sheets("Main").Cells(16, _
6)
ThisWorkbook.Sheets("Tabelle1").Cells(i, 14) = ActiveWorkbook.Sheets("Main").Cells(17, _
6)
' Datei schließen, ohne Änderungen zu speichern
ActiveWorkbook.Close savechanges:=False
' neue Datei aus dem Ordner lesen
datei = Dir()
' Ende der Schleife
Loop
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Transfer() 'die Daten jeder Datei werden in eine eigene Zeile geschrieben Dim Datei As String Dim Q As Worksheet ' Q wie Quelle Dim Z As Range ' Z wie Ziel aber auch Zelle Dim A 'A wie Adresse Const pfad = "P:\Sales-Marketing Bräcker\7_Product Management\7.4_Products\13000_Ringe\Ringuntersuchungen\" Set Z = ThisWorkbook.Sheets("Tabelle1").Range("A1") Datei = Dir(pfad) ' Dateien des Quellordners ermitteln Do While Datei "" 'solang eine Datei gefunden wurde Workbooks.Open Filename:=pfad & Datei ' Datei öffnen Set Q = ActiveWorkbook.Sheets("Main") For Each A In Split("J2 I1 F19 M19 L19 M21 L20 M23 L21 F25 F22 F15 F16 F17") 'Split splittet per Default nach Leerstellen Z = Q.Range(A).Value Set Z = Z.Offset(0, 1) 'eine Zelle weiter nach recht Next Set Z = Z.EntireRow.Range("A2") ' in Spalte A, eine Zeile tiefer als die aktuelle Zeile ActiveWorkbook.Close savechanges:=False ' Datei schließen, ohne Änderungen zu speichern Datei = Dir() ' nächste Datei Loop ' Ende der Schleife End Sub

Sub aaa() 'die Daten jeder Datei werden in eine eigene Zeile geschrieben ' Variablen deklarieren Dim datei As String Dim pfad As String Dim i As Integer Dim wksZiel As Worksheet, wksQuelle As Worksheet Set wksZiel = ThisWorkbook.Sheets("Tabelle1") i = 1 ' Quellordner wird festgelegt pfad = "P:\Sales-Marketing Bräcker\7_Product Management\7.4_Products\13000_Ringe\Ringuntersuchungen\" ' Dateien des Quellordners ermitteln datei = Dir(pfad & "*.xl*") ' Schleife, um jede Datei auszulesen Do While datei "" ' Datei öffnen (Pfad wird aus den Variablen pfad und datei zusammengesetzt Set wksQuelle = Workbooks.Open(Filename:=pfad & datei).Sheets("Main") ' Zählvariable für die Zeilen (je Datei eine neue Zeile) i = i + 1 ' Cells wird wie folgt verwendet Cells(Zeilennummer, Spaltennummer) With wksQuelle wksZiel.Cells(i, 1) = .Cells(2, 10) wksZiel.Cells(i, 2) = .Cells(1, 9) wksZiel.Cells(i, 3) = .Cells(19, 6) wksZiel.Cells(i, 4) = .Cells(19, 13) wksZiel.Cells(i, 5) = .Cells(19, 12) wksZiel.Cells(i, 6) = .Cells(21, 13) wksZiel.Cells(i, 7) = .Cells(20, 12) wksZiel.Cells(i, 8) = .Cells(23, 13) wksZiel.Cells(i, 9) = .Cells(21, 12) wksZiel.Cells(i, 10) = .Cells(25, 6) wksZiel.Cells(i, 11) = .Cells(22, 6) wksZiel.Cells(i, 12) = .Cells(15, 6) wksZiel.Cells(i, 13) = .Cells(16, 6) wksZiel.Cells(i, 14) = .Cells(17, 6) End With ' Datei schließen, ohne Änderungen zu speichern wksQuelle.Parent.Close savechanges:=False ' neue Datei aus dem Ordner lesen datei = Dir() ' Ende der Schleife Loop End Sub

Hallo zusammen,
"da es mir ein Anliegen ist, meine Helfer so weit zu unterstützen, dass Sie sich nur auf das Wesentlich konzentrieren können, und sich nicht zuerst die Frage stellen, "was bedeutet überhaupt Fehler 9", habe ich selbstverständlich Laufzeitfehler 9 im Internet recherchiert und folgendes gefunden:
Laufzeitfehler 9 heißt normalerweise, dass du auf ein Tabellenblatt verweist, das es nicht gibt. Also ist entweder das Blatt "Kalender" oder "Feiertage" anders geschrieben als im Code. Daran könnte zB ein Leerzeichen nach dem eigentlich Wort schuld sein.
Darauf habe ich selber geprüft, ob diese Zustand bei mir vorkommt und dabei der Fehlerursache gefunden, sodass ich nicht lang auf eine Antwort auf eine Frage, die sich nicht mehr stellt"
So ungefähr passiert innerhalb von max. 3 Minunten bei 90% aller Fragenden. Für den anderen, muss man anstupsen ;-)
Man weiss nicht, was man selber kann, solang man es nicht versucht hat.
VG
Yal

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread