Hat jemand eine Idee? Danke.
Sub Makro1()
' Makro1 Makro
' Makro am 07.07.2006 von Manfred aufgezeichnet
Columns("A:A").Select
Selection.Copy
Sheets("Tabelle2").Select
Columns("A:A").Select
Application.CutCopyMode = False
Selection.NumberFormat = "@"
Sheets("Tabelle1").Select
Selection.Copy
Sheets("Tabelle2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Tabelle1").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("Tabelle2").Select
Columns("A:A").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A1").Select
Sheets("Tabelle1").Select
End Sub
Sub Makro1()
Dim i As Integer, Lrow As Long
Lrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To Lrow 'Startzeile 1 bis letzte gefüllte Zelle in Spalte A
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 123#, 33.75 + i * 10, _
114.75, 24#).Select '33.75 + i * 10 bewirkt den leichten Versatz nach unten
Selection.Characters.Text = CStr(Range("A" & i)) 'statt kopieren
With Selection.Characters(Start:=1, Length:=4).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Next i
End Sub