|
Es funktioniert!!!
Herzlichen Dank Ralf!!!
So sieht es jetzt aus:
Option Explicit
Sub kopieren()
Dim Dennis As String, Ebbo As String, Fudty As String, Hanesz As String, Holle As String, Robin As String
Worksheets("Tabelle").Select
Dennis = Range("o5")
Ebbo = Range("o6")
Fudty = Range("o7")
Hanesz = Range("o8")
Holle = Range("o9")
Robin = Range("o10")
Worksheets("Tabelle").Select
Worksheets("Tabelle").Range("b13").Select
If Worksheets("Tabelle").Range("b13").Offset(1, 0) <> "" Then
Worksheets("Tabelle").Range("b13").End(xlDown).Select
End If
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = Dennis
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Ebbo
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Fudty
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Hanesz
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Holle
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Robin
Range("O5:O10").Select
Selection.Copy
Range("N5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("I2").Select
Dim Zelle As Range
For Each Zelle In Range("B14:G47").SpecialCells(xlCellTypeConstants)
If IsNumeric(Zelle) Then Zelle = CDbl(Zelle)
Next
End Sub
|