Hallo,
ich werde aus deinem Code nicht wirklich schlau.
Du kopierst aus Blatt1 verschiedene Zellbereiche immer ins Blatt2 in die Zelle B3 - damit überschreibst du doch dort immer wieder die Werte.
Dann kopierst du einen Zellbereich (Spalte J) ins Blatt1 in verschiedene Spalten. Allerdings kopierst du immer wieder den gleichen Bereich.
Meinst du so?
Sub KVG_Start()
Dim raBereich As Range
Application.ScreenUpdating = False
With Worksheets("TAB1")
.Range("B2:K4").Copy
Worksheets("TAB2").Range("B3").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Set raBereich = Worksheets("TAB3").Range("J31:L33,J35:L36,J38:L38,J40:L40,J42:L43,J45:L46,J48:L49,J51:L51")
raBereich.Copy
.Cells(12, "N").Resize(, 3).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Cells(27, "N").Resize(14, 3).FormulaR1C1 = "=IFERROR(IF(R[-15]C>1,1,R[-15]C),0)"
.Cells(41, "N").Resize(, 3).FormulaR1C1 = "=SUM(R[-14]C:R[-1]C)/14"
End With
Application.CutCopyMode = False
Set raBereich = Nothing
End Sub
Gruß Werner
|