Hello again,
folgedes Makro liest Werte aus den Tabelle 3 bis vorhandenen Tabelle ein und trägt diese werte in der Tabelle übersicht ein.Auf meinem Rechner braucht benötigt dieses Makro ca. 5 bis 6 Sek.
Wer hilft mir den Ablauf zu beschleunigen ???
VIELEN DANK
Sub Makro2()
Dim iCounter As Integer, icolumns As Integer
Dim t As Integer
Dim x As Integer
Application.Cursor = xlWait 'Sanduhr einschalten
On Error GoTo errorhandler
Worksheets("Übersicht").Activate
Application.ScreenUpdating = False
Range("A3:AA150").Delete
Application.ScreenUpdating = False
For iCounter = Sheets(3).Index To Worksheets.Count
icolumns = (icolumns + 1)
For t = 15 To 120
t = (t + 0)
Cells(3, icolumns + 1) = Worksheets(iCounter).Range("B7").Value
Cells(t - 11, 1) = Worksheets(iCounter).Cells(t + 1, 15).Value
Cells(t - 11, icolumns + 1) = Worksheets(iCounter).Cells(t + 1, 23).Value
Cells(t - 11, icolumns + 1).NumberFormat = "0.00_);[Red]-0.00"
Cells(t - 11, icolumns).NumberFormat = "0.00_);[Red]-0.00"
With Cells(3, icolumns).Font
.Bold = True
.Underline = xlUnderlineStyleSingle
.ColorIndex = 1
End With
Next t
Next iCounter

'ausrechnen
Application.ScreenUpdating = False
icolumns = Cells(x + 4, 255).End(xlToLeft).Column + 1
For x = 4 To Cells(Rows.Count, 1).End(xlUp).Row
Cells(x, icolumns).FormulaR1C1 = "=SUM(RC1:RC" & icolumns - 1 & ")"
Cells(x, icolumns + 1).FormulaR1C1 = "=average(RC1:RC" & icolumns - 1 & ")"
Cells(x, icolumns + 2).FormulaR1C1 = "=max(RC1:RC" & icolumns - 1 & ")"
Cells(x, icolumns + 3).FormulaR1C1 = "=min(RC1:RC" & icolumns - 1 & ")"
Cells(3, icolumns).FormulaR1C1 = "=""Jahrestotal"""
Cells(3, icolumns + 1).FormulaR1C1 = "=""Durchschnitt"""
Cells(3, icolumns + 2).FormulaR1C1 = "=""Max."""
Cells(3, icolumns + 3).FormulaR1C1 = "=""Min."""
With Cells(x, icolumns).Font
.Bold = True
'.Underline = xlUnderlineStyleSingleAccounting
.ColorIndex = 1
End With
With Cells(x, icolumns + 1).Font
.Bold = True
'.Underline = xlUnderlineStyleSingleAccounting
.ColorIndex = 8
End With
With Cells(x, icolumns + 2).Font
.Bold = True
'.Underline = xlUnderlineStyleSingleAccounting
.ColorIndex = 4
End With
With Cells(x, icolumns + 3).Font
.Bold = True
'.Underline = xlUnderlineStyleSingleAccounting
.ColorIndex = 5
End With
Next x
With Range("A3:AA170").Font
.Size = 12
End With
Range("A:A").Font.Bold = True
Range("B4:AA4").EntireColumn.AutoFit
With Range("B4:AA170")
.RowHeight = 30
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
End With
With Range("A:A")
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
End With
Application.Cursor = xlDefault 'Sanduhr ausschalten

errorhandler:
Exit Sub
End Sub