Makro zum oeffnen mehrerer Arbeitsmappen

Sub Auswertung_mehrerer_Tabellen() ' Auswertung_mehrerer_Tabellen Macro ' Keyboard Shortcut: Ctrl+k strPath = "C:\Users\XXX\Desktop\test" 'Pfad auswahlen bzw. anpassen. strExt = "" Dim strFile As String If strPath = "" Then Exit Sub Else strFile = Dir(strPath & strExt) Do While Len(strFile) > 0 Workbooks.Open Filename:=strPath & strFile Range("AF8").Select 'Anpassen, wenn die Zelle sich aendert. Range(Selection, Selection.End(xlDown)).Select 'Anpassen, wenn sich der markierte Bereich aendert. Selection.Copy Windows("Book1").Activate 'Anpassen, wenn sich die Zieldabei aendert ActiveSheet.Paste ActiveCell.Offset(0, 1).Select Application.DisplayAlerts = False Workbooks(strFile).Close strFile = Dir() Application.DisplayAlerts = True Loop End If Range("A294").Select 'Anpassen, wenn sich die zu markierende Zelle aendert. End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Robert,
Hauptproblem ist, dass das Trennzeichen "\" zwischen Verzeichnis und Dateiname fehlt.
Sowohl bei der Dateisuche -deshalb findet Dir dann ggf. keine Dateien- als auch beim Öffnen der Dateien -hier käme ggf. eine Fehlermeldung.
Du musst das "\" in strExt einbauen und vor dem Starten der Do-Schleife am Pfad anfügen.
Zusätzlich ist die Prüfung ratsam, ob das Verzeichnis existiert.
Generell kann man aber meist so programmieren, dass Select/Selection-Konstruktionen vermieden werden.
Gruß
Franz

Sub Auswertung_mehrerer_Tabellen()
' Auswertung_mehrerer_Tabellen Macro
' Keyboard Shortcut: Ctrl+k
Dim strPath As String, strExt As String
Dim strFile As String
Dim wkbData As Workbook, wksData As Worksheet
Dim wksZiel As Worksheet, rngZiel As Range
Dim lngSpalte As Long, lngZeile As Long
Set wksZiel = ActiveSheet
Set rngZiel = ActiveCell 'Startzelle für das Einfügen von Daten - Zelle irgendwie fest  _
vorgeben
With wksZiel
'set rngZiel=wksZiel.Range("A1")
'oder
'Set rngZiel = .Cells(1, .Columns.Count).End(xlToLeft) 'letzte Zelle mit Inhalt in  _
Zeile 1
'If Not IsEmpty(rngZiel) Then Set rngZiel = rngZiel.Offset(0, 1)
End With
strPath = "C:\Users\XXX\Desktop\test"
'Pfad auswahlen bzw. anpassen.
strExt = "\*.xls*" 'Alle Excel-Dateien - ggf. anpassen z.B. "\*.csv"
If strPath = "" Then
Exit Sub
ElseIf Dir(strPath, vbDirectory) = "" Then
MsgBox "Verzeichnis " & vbLf & strPath & vbLf & "nicht gefunden!"
Exit Sub
Else
Application.ScreenUpdating = False
strFile = Dir(strPath & strExt)
strPath = strPath & "\"
Do While Len(strFile) > 0
Set wkbData = Workbooks.Open(Filename:=strPath & strFile, ReadOnly:=True)
Set wksData = wkbData.Worksheets(1)
With wksData
'Anpassen, wenn sich der zu kopierende Bereich aendert.
lngSpalte = .Range("AF1").Column
lngZeile = .Cells(.Rows.Count, lngSpalte).End(xlUp).Row
If lngZeile >= 8 Then 'ab Zeile 8 Daten kopieren
.Range(.Cells(8, lngSpalte), .Cells(lngZeile, lngSpalte)).Copy _
Destination:=rngZiel
End If
End With
'Einfügezelle für nächste Datei setzen
Set rngZiel = rngZiel.Offset(0, 1)
Application.DisplayAlerts = False
wkbData.Close savechanges:=False
Application.DisplayAlerts = True
Set wksData = Nothing
Set wkbData = Nothing
strFile = Dir()
Loop
'Anpassen, wenn sich die zu markierende Zelle aendert.
Range("A294").Select
Application.ScreenUpdating = True
End If
End Sub

Beliebteste Forumthreads (12 Monate)

Makro zum oeffnen mehrerer Arbeitsmappen

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro zum oeffnen mehrerer Arbeitsmappen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread