Hallo Zusammen,
ich war schon eine ganze Weile nicht mehr hier, aber ihr könnt mir sichelich schnell helfen.
Ich habe folgendes Problem: Mehrere Exceldatei(gleicher Aufbau) sollen in einem Ordner gesammelt werden. Eine Auswertungsdatei soll alle Exceldateien auslesen und sie in einem Tabellenblatt anzeigen.
Manchmal funktioniert es - manchmal nicht.
Woran kann es liegen oder was kann ich umschreiben?
Vielen Dank
xxl83
Sub Einlesen()
Call EventsOff
Dim Dateien As Integer
Dim DateiName As String
Dim zeile As Long
With Application.FileSearch
.NewSearch
.LookIn = ActiveWorkbook.Path
.Filename = "*.xls"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
DateiName = Dir(.FoundFiles(Dateien))
If DateiName <> ThisWorkbook.Name Then
Workbooks.Open Filename:=.FoundFiles(Dateien)
zeile = ThisWorkbook.Sheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1
Workbooks(DateiName).Sheets(1).Range("B5:B107").Copy
ThisWorkbook.Sheets(1).Range("A" & zeile).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Workbooks(DateiName).Close
End If
Next Dateien
End If
End With
Call EventsOn
Call DoppelteNr
End Sub
Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Sub DoppelteNr()
Dim iRow As Integer, iRowL As Integer
iRowL = Cells(Cells.Rows.Count, 1).End(xlUp).Row
For iRow = iRowL To 1 Step -1
If WorksheetFunction.CountIf(Columns(1), Cells(iRow, 1)) > 1 Then
Rows(iRow).Delete
End If
Next iRow
End Sub
