..bin schon wieder hier .....nachdem die Variante Datensätze mit spezialfilter zu selectieren und dann das ergebnis in tabelle zwei zu kopieren nicht funktioniert...habe ich nun umdisponiert und möchte einen Datenbereich sortieren und im anschluss nach tabelle mittels code kopieren...
auch hier stellt es mich auf und weiss nicht warum...
hat vielleicht jemand einen vorschlag ?
grüsse und danke
johann
Codeteil:
Sub Sort_KZ()
Worksheets("Tabelle1").Activate
Application.WindowState = xlMaximized
'Datenbereich finden (Hintergrundfarbe 37)
ActiveSheet.Range("B24").Select
For ActRow = 1 To 600000
If ActiveCell.Offset(ActRow, 0).Interior.ColorIndex <> 37 Then Exit For
Next ActRow
PTWdata = "Tabelle!R24C2:R" & Trim(Str(24 + ActRow - 1)) & "C19"
On Error Resume Next
'Datenbereich nach "1" in der Spalte S sortieren
Range("PTWdata").Select
Selection.Sort Key1:=Range("S25"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Range("B39").Select
'Nach sortierung Datenbereich neu ausrechnen letzte zeile hat eine andere Farbe
ActiveSheet.Range("B24").Select
For ActRow = 1 To 600000
If ActiveCell.Offset(ActRow, 0).Interior.ColorIndex <> 37 Then Exit For
Next ActRow
'neuer Datenbereich
PCopydata = "Tabelle1!R24C2:R" & Trim(Str(24 + ActRow - 1)) & "C19"
'Datenbereich von PCOpydata nach Tabelle 2 kopieren und zurückkehren nach Tabelle1
'Ab hier funktioniert es nicht mehr ...vielleicht kommt das change ereignis von userform in die quere ..
'ich weiss es nicht
Range("PCopydata").Select
'Range("A24:S37").Select
'Range("S24").Activate
Selection.Copy
'Application.EditDirectlyInCell = False
Application.CutCopyMode = False
Sheets("Tabelle2").Select
Range("A24").Select
ActiveSheet.Paste
Sheets("Tabelle1").Select
Application.CutCopyMode = False
'nicht selectierte Datensätze von Tabelle 1 löschen ....zukunftsmusik