Private Sub cmb_BeArb_Click()
Application.ScreenUpdating = False
ActiveCell.Copy
With ActiveCell
.Offset(0, 1).PasteSpecial Paste:=xlFormulas, Operation:=xlNone
.Offset(0, 2).PasteSpecial Paste:=xlFormulas, Operation:=xlNone
.Offset(0, 6).PasteSpecial Paste:=xlFormulas, Operation:=xlNone
.Offset(0, 7).PasteSpecial Paste:=xlFormulas, Operation:=xlNone
.Offset(0, 8).PasteSpecial Paste:=xlFormulas, Operation:=xlNone
End With
Application.CutCopyMode = False
ActiveCell.Offset(0, -8).Activate
Selection.Resize(0, 8).Select
'in dem Bereich soll der relative Bezug durch fixierten Bezug ersetzt werden
'Code von Eule
Dim c As Range
Dim X As String, x1 As String, x2 As String
Dim dlz As Byte
For Each c In Selection
If c.HasFormula = True Then
dlz = dlz + 1
X = c.Formula
If IsNumeric(Mid(X, 3, 1)) And Not IsNumeric(Mid(X, 2, 1)) Then
x1 = Mid(X, 2, 1)
x2 = Right(X, Len(X) - 2)
c.Formula = "=$" & x1 & "$" & x2
End If
If IsNumeric(Mid(X, 4, 1)) And Not IsNumeric(Mid(X, 3, 1)) Then
x1 = Mid(X, 2, 2)
x2 = Right(X, Len(X) - 3)
c.Formula = "=$" & x1 & "$" & x2
End If
End If
Next c
Application.ScreenUpdating = True
End Sub
Selection.Resize(0, 8).Select
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen