Sub
Makro1()
Sheets(
"Sum"
).
Select
Range(
"B2:K21"
).
Select
Selection.ClearContents
Dim
iCounter
As
Integer
For
iCounter = 2
To
21
Sheets(
"Calc"
).
Select
Range(
"J1"
).
Select
Selection.Copy
Sheets(
"Sum"
).
Select
Range(
"B"
& iCounter).
Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=
False
, Transpose:=
False
Next
iCounter
For
iCounter = 2
To
21
Sheets(
"Calc"
).
Select
Range(
"J1"
).
Select
Selection.Copy
Sheets(
"Sum"
).
Select
Range(
"C"
& iCounter).
Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=
False
, Transpose:=
False
Next
iCounter
For
iCounter = 2
To
21
Sheets(
"Calc"
).
Select
Range(
"J1"
).
Select
Selection.Copy
Sheets(
"Sum"
).
Select
Range(
"D"
& iCounter).
Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=
False
, Transpose:=
False
Next
iCounter
For
iCounter = 2
To
21
Sheets(
"Calc"
).
Select
Range(
"J1"
).
Select
Selection.Copy
Sheets(
"Sum"
).
Select
Range(
"E"
& iCounter).
Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=
False
, Transpose:=
False
Next
iCounter
For
iCounter = 2
To
21
Sheets(
"Calc"
).
Select
Range(
"J1"
).
Select
Selection.Copy
Sheets(
"Sum"
).
Select
Range(
"F"
& iCounter).
Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=
False
, Transpose:=
False
Next
iCounter
For
iCounter = 2
To
21
Sheets(
"Calc"
).
Select
Range(
"J1"
).
Select
Selection.Copy
Sheets(
"Sum"
).
Select
Range(
"G"
& iCounter).
Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=
False
, Transpose:=
False
Next
iCounter
For
iCounter = 2
To
21
Sheets(
"Calc"
).
Select
Range(
"J1"
).
Select
Selection.Copy
Sheets(
"Sum"
).
Select
Range(
"H"
& iCounter).
Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=
False
, Transpose:=
False
Next
iCounter
For
iCounter = 2
To
21
Sheets(
"Calc"
).
Select
Range(
"J1"
).
Select
Selection.Copy
Sheets(
"Sum"
).
Select
Range(
"I"
& iCounter).
Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=
False
, Transpose:=
False
Next
iCounter
For
iCounter = 2
To
21
Sheets(
"Calc"
).
Select
Range(
"J1"
).
Select
Selection.Copy
Sheets(
"Sum"
).
Select
Range(
"J"
& iCounter).
Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=
False
, Transpose:=
False
Next
iCounter
For
iCounter = 2
To
21
Sheets(
"Calc"
).
Select
Range(
"J1"
).
Select
Selection.Copy
Sheets(
"Sum"
).
Select
Range(
"K"
& iCounter).
Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=
False
, Transpose:=
False
Next
iCounter
Sheets(
"Sum"
).
Select
Range(
"A23:K25"
).
Select
ActiveSheet.Shapes.AddChart2(227, xlLineMarkers).
Select
ActiveChart.SetSourceData Source:=Range(
"Sum!$A$23:$K$25"
)
ActiveChart.Parent.Cut
Sheets(
"Diagramm"
).
Select
ActiveSheet.Paste
End
Sub