aus Zwischenablage in Tabelle
18.09.2006 20:59:31
Wolfgang
mit folgendem Code, den ich mit großer Hilfe aus dem Forum in jetziger Form zusammenstellen konnte, soll erreicht werden, dass ein Text aus der Zwischenablage in ein Tabellenblatt, in diesem Fall das ausgeblendete Tabellenblatt "Auftrag" kopiert wird. In der Folge soll die Schriftfarbe schwarz sein und die Wörter auf Spalten aufgeteilt werden. Weiterhin sollen bei einer bestimmten Ziffernfolge, die in Klammern erscheint, die Klammern entfernt werden. Grundsätzlich funktioniert das auch, aber irgendwie erscheint eine Fehlermeldung. Ich mußte zwischenzeitlich leider erfahren, dass die Zwischenablage in Excel bei einer VBA-Aktion wohl geleert wird. Somit habe ich eine UF mit einer Schaltfläche eingebaut, die zunächst aufgerufen wird um dann den Text in die Zwischenablage zu kopieren, damit dann in der Folge die Aktion ausgeführt wird. Was mache ich noch verkehrt? - Wäre für jede weitere Hilfestellung sehr dankbar.
Herzliche Grüße
Wolfgang
Hier der bisherige Code:
Sub ZwA()
Sheets("Auftrag").Activate
Range("C4").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
With ActiveCell.Characters(Start:=1, Length:=28).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
'Klammer oder sonstige Zeichen, Wörter entfernen
'Buchstabenfolge bzw. Wörter werden in Zellen aufgeteilt
With Worksheets("Auftrag")
Range("C4").Select
Selection.TextToColumns Destination:=Range("A7"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=" ", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True
With Columns("C:C")
.Replace What:="(", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:=")", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With
End With
End Sub