Option
Explicit
Sub
WerteHinzufuegen()
Range(
"H2:H150"
).ClearContents
Range(
"F2:F150"
).Copy
Range(
"H2:H150"
).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlAdd
Range(
"I2:I150"
).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlAdd
Range(
"K2:K150"
).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlAdd
Range(
"F2:F150"
).ClearContents
Application.CutCopyMode =
False
Application.ScreenUpdating =
True
End
Sub
Sub
SchleifeZumzum()
Dim
Rng
As
Range, c
As
Range
Application.ScreenUpdating =
False
Set
Rng = Range(
"F2:F150"
)
For
Each
c
In
Rng
If
c.Value <>
""
Then
c.Offset(, 2).Value = c.Value
c.Offset(, 3).Value = c.Value
c.Offset(, 5).Value = c.Value
c.ClearContents
End
If
Next
c
Application.ScreenUpdating =
True
End
Sub