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
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen