Wert einer Zelle in die nächste übertragen

Sub Leerzeilen()
Set wksTemp = ActiveSheet
Menge = wksTemp.UsedRange.Rows.Count
For i = Menge To 2 Step -1
Menge1 = i & ":" & i
Rows(Menge1).Select
Selection.Insert Shift:=xlDown
Next
ueber5
End Sub

Sub ueber5()
Dim o
Dim p
Dim Nome
Dim q
Dim r
Dim s
Dim t
Application.ScreenUpdating = False
Nome = ThisWorkbook.Name
Set t = ActiveSheet.UsedRange
p = t.Rows.Count
s = t.Columns.Count
Workbooks(Nome).Worksheets("tabelle1").Range("A1").Select
For r = 1 To s
For q = 1 To p
o = Selection.Value
o = Right(o, 5)
ActiveCell.Offset(1, 0).Value = o
Workbooks(Nome).Worksheets("tabelle1").Cells(q, r).Select
Next q
Next r
o = Selection.Value
o = Left(o, 5)
ActiveCell.Offset(1, 0).Value = o
Range("A1").Select
Application.ScreenUpdating = True
End Sub

Sub weniger5()
Dim a
Dim e
Dim Nomen
Dim b
Dim j
Dim k
Dim m
Application.ScreenUpdating = False
Nomen = ThisWorkbook.Name
Set m = ActiveSheet.UsedRange
e = m.Rows.Count
k = m.Columns.Count
Workbooks(Nomen).Worksheets("tabelle1").Range("A1").Select
For j = 1 To k
For b = 1 To e
a = Selection.Value
a = Left(a, 5)
ActiveCell.Value = a
Workbooks(Nomen).Worksheets("tabelle1").Cells(b, j).Select
Next b
Next j
a = Selection.Value
a = Left(a, 5)
ActiveCell.Value = a
Range("A1").Select
Application.ScreenUpdating = True
End Sub