Option Explicit
Private Function AlleTabellen(objWB As Workbook)
Dim meAr() As String
Dim i As Integer, ii As Integer
For i = 1 To objWB.Sheets.Count
If objWB.Sheets(i).Visible = xlSheetVisible Then
Redim Preserve meAr(ii)
meAr(ii) = objWB.Sheets(i).Name
ii = ii + 1
End If
Next i
AlleTabellen = meAr
End Function
Sub AlleDateien()
Dim strFile As String
Dim objFile As Workbook, tempFile As Workbook
Dim objSH As Worksheet
Dim iCalc As Integer
'Pfad anpassen, am ende auf \ achten *********
Const strPath As String = "C:\Mein Ordner\"
With Application
iCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
strFile = Dir(strPath & "*.xls")
Do While strFile <> ""
If strFile Like "*.xls" Then
Set tempFile = Workbooks.Open(strPath & strFile, , True)
If objFile Is Nothing Then
tempFile.Sheets(AlleTabellen(tempFile)).Copy
Set objFile = ActiveWorkbook
Else
tempFile.Sheets(AlleTabellen(tempFile)).Copy After:=objFile.Sheets(objFile.Sheets.Count)
End If
tempFile.Close False
End If
strFile = Dir()
Loop
For Each objSH In objFile.Worksheets
objSH.UsedRange.Value = objSH.UsedRange.Value
Next objSH
.Calculation = iCalc
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
Private Function AlleTabellen(objWB As Workbook)
Dim meAr() As String
Dim i As Integer, ii As Integer
'hier eventuell mit If weitere Tabellen ein oder ausschließen
For i = 1 To objWB.Sheets.Count
If objWB.Sheets(i).Visible = xlSheetVisible Then
Redim Preserve meAr(ii)
meAr(ii) = objWB.Sheets(i).Name
ii = ii + 1
End If
Next i
AlleTabellen = meAr
End Function
Sub AlleDateien()
Dim strFile As String
Dim objFile As Workbook, tempFile As Workbook
Dim objSH As Worksheet
Dim iCalc As Integer
'Pfad anpassen, am ende auf \ achten *********
Const strPath As String = "C:\Mein Ordner\"
With Application
iCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
strFile = Dir(strPath & "*.xls")
Do While strFile <> ""
If strFile Like "*.xls" Then
Set tempFile = Workbooks.Open(strPath & strFile, , True)
tempFile.Sheets(AlleTabellen(tempFile)).Copy
Set objFile = ActiveWorkbook
tempFile.Close False
For Each objSH In objFile.Worksheets
objSH.UsedRange.Value = objSH.UsedRange.Value
Next objSH
End If
strFile = Dir()
Loop
.Calculation = iCalc
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub