makro schneller machen
05.12.2014 13:01:24
Sarah
hat jemand vielleicht vorschläge wie ich das nachfolgende makro schneller machen könnte ?
bin froh für jede hilfe
Dim Zeile As Long
Dim ZeileMax As Long
Dim n As Integer
Dim i As Integer
Dim zeileaktuell As Integer
Dim zwischenwert As String
Zeile = 2
zeileaktuell = 2
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
Worksheets("Sheet1").Activate
ZeileMax = ActiveSheet.UsedRange.Rows.Count
Range("A1", "K1").Select
Selection.Copy
Sheets("Daten mit Perioden").Select
Range("A1", "K1").Select
ActiveSheet.Paste
Range("H1").FormulaR1C1 = "K/Wert Summe"
Columns("H:H").ColumnWidth = 17.29
Range("J1").FormulaR1C1 = "K/Wert Periode"
For Zeile = 2 To ZeileMax
i = 1
For n = 1 To 12
Worksheets("Sheet1").Activate
Range("A" & Zeile, "I" & Zeile).Select
Selection.Copy
Sheets("Daten mit Perioden").Select
Range("A" & Zeile, "I" & Zeile).Select
ActiveSheet.Range("A" & zeileaktuell, "I" & zeileaktuell).Select
ActiveSheet.Paste
Worksheets("Sheet1").Activate
Range(Col_Letter(i + 13) & Zeile).Select
Selection.Copy
Sheets("Daten mit Perioden").Select
Range("J" & zeileaktuell).Select
ActiveSheet.Paste
Cells(zeileaktuell, 11).Value = n
zeileaktuell = zeileaktuell + 1
i = i + 1
Next n
Next Zeile
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End With
End Sub