AW: richtig löschen
02.11.2016 22:51:46
Gerd
Hallo Fred!
Auf die Schnelle von Ludmilla aus deinem anderen Thread rübergeholt.
Sub getMoreSpeed(Optional ByVal Modus As Boolean = True)
' Schaltet Kalkulationsmodus, Bildschirmaktualisierung und Event-Handling aus/ein
Dim intCalculation As Integer
Dim bRan As Boolean
If Modus And Not bRan Then intCalculation = Application.Calculation
With Application
.ScreenUpdating = Not Modus
.EnableEvents = Not Modus
.DisplayAlerts = Not Modus
.Calculation = IIf(Modus, xlCalculationManual, intCalculation)
.Cursor = IIf(Modus, xlWait, xlDefault)
End With
bRan = Modus
End Sub
Sub DatenImport()
Dim wksZ As Worksheet, wksQ As Worksheet, wkbQ As Workbook, wksQArray, WB As Long
Const strWkbQName As String = "Saison11_12,Saison12_13,Saison13_14,Saison14_15,Saison15_16, _
Saison16_17 """
Const strWkbQ As String = "5Jahre.xls,4Jahre.xls,3Jahre.xls,2Jahre.xls,1Jahre.xls,Aktuell.xls" _
_
Call getMoreSpeed(True)
Worksheets("Basis").Range("A3:J50000").EntireRow.Delete
Worksheets("Basis").Range("A2:J2").Clear
Set wksZ = ThisWorkbook.Sheets("Basis")
For WB = LBound(Split(strWkbQ, ",")) To UBound(Split(strWkbQ, ","))
On Error Resume Next
Set wkbQ = Workbooks(Split(strWkbQ, ",")(WB))
On Error Goto 0
If wkbQ Is Nothing Then
Set wkbQ = Workbooks.Open(ThisWorkbook.Path & "\00_Daten\" & Split(strWkbQ, ",")(WB))
End If
For Each wksQ In wkbQ.Worksheets
wksQArray = wksQ.Cells(1, 1).CurrentRegion.Offset(1).Resize(, 9).Value
wksZ.Cells(wksZ.Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(wksQArray, 1), UBound( _
wksQArray, 2)) = wksQArray
wksZ.Cells(wksZ.Rows.Count, "J").End(xlUp).Offset(1).Resize(UBound(wksQArray, 1) - 1) = _
Split(strWkbQName, ",")(WB)
Next
wkbQ.Close False 'QuellWB ohne zu speichern schließen
Set wkbQ = Nothing
Next WB
Call getMoreSpeed(False)
End Sub
Gruß Gerd