AW: zeig uns doch den Code der UF... oT
30.03.2015 11:45:10
EtoPHG
Hallo Sasa,
Ersetze deinen Code durch diesen:
Private Sub Hinzufügen_Click()
Dim ws As Worksheet
Dim rC As Range
Set ws = ThisWorkbook.Worksheets(Blatt.Text)
With ws
With .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
.Value = Titel
.Offset(0, 1) = "?+?" & Bezeichnung
.Offset(0, 2) = Freigabe
.Offset(0, 3) = Auflagen
.Select
End With
With .Sort
.SortFields.Clear
.SortFields.Add Key:=ws.Range(ws.Cells(2, 1), _
ws.Cells(ws.Rows.Count, 1).End(xlUp)), _
SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
.SetRange Range(ws.Cells(2, 1), ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(, 13))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
With .Columns(2).Find("?+?", .Cells(1, 2), xlValues, _
xlPart, xlByRows, xlNext, True, False)
.Value = Replace(.Text, "?+?", "")
.Offset(, -1).Activate
End With
End With
Unload Datenhinzufügen
End Sub
Gruess Hansueli