statt ausschneiden Kopieren



Excel-Version: 8.0 (Office 97)
nach unten

Betrifft: statt ausschneiden Kopieren
von: olga
Geschrieben am: 25.06.2002 - 16:28:56

Hallo

Kann mir jemand helfen
bei folgenden Code, soll es nicht den Datensatz ausschneiden, sondern kopieren, und in dem bestehendem Datenblatt Hintergrundfarbe wechseln.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim z As Long
If Target.Column <> 4 Then Exit Sub
Select Case Target.Value
Case "d"
z = Worksheets("bez").Cells(Rows.Count, 1).End(xlUp).Row + 1
Rows(Target.Row).EntireRow.Copy Destination:=Worksheets("bez").Cells(z, 1)
Worksheets("bez").Cells(z, 2).Value = Date
Rows(Target.Row).Delete


Vielen Dank
Olga

nach oben   nach unten

Re: statt ausschneiden Kopieren
von: Michael Scheffler
Geschrieben am: 25.06.2002 - 16:45:05

Hallo Olga,

wie wäre es, wenn Du die Zeile


Rows(Target.Row).Delete

auskommentierst?

Gruß

Micha


nach oben   nach unten

funktioniert bei mir nicht
von: olga
Geschrieben am: 25.06.2002 - 17:09:18

Ich habe es probiert und dies koppt bei mir nicht.

nach oben   nach unten

Re: funktioniert bei mir nicht
von: Thomas
Geschrieben am: 25.06.2002 - 20:41:17

Hallo Olga
Probier so :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim z As Long
If Target.Column <> 4 Then Exit Sub
Select Case Target.Value
Case "d"
z = Worksheets("bez").Cells(Rows.Count, 1).End(xlUp).Row + 1
Rows(Target.Row).EntireRow.Copy Destination:=Worksheets("bez").Cells(z, 1)
Worksheets("bez").Cells(z, 2).Value = Date
Rows(Target.Row).Delete

End Select

End Sub

Gruß

nach oben   nach unten

Re: funktioniert bei mir nicht
von: olga
Geschrieben am: 26.06.2002 - 17:30:00

Hallo Tom
ich glaube da ist etwas falsch gelaufen, da dies ist mein Code
so funktioniert, aber ich möchte dass der Datensatz nicht verschoben wird, sondern kopiert und Hintergrundfarbe soll geändert werden.

Vielen Danak

Olga


nach oben   nach unten

Re: funktioniert bei mir nicht
von: Thomas
Geschrieben am: 27.06.2002 - 08:21:01

Sorry
Sub Delete()
Dim i As Long, j As Long, maxzeilen As Long
maxzeilen = Range("A65536").End(xlUp).Row
i = 1
j = 0
Do While i < maxzeilen
If Cells(i, 1).Value = "" Then
Rows(i).Delete
j = j + 1
If i + j >= maxzeilen Then Exit Sub
i = i - 1
End If
i = i + 1
Loop
End Sub

Das mit die farbe hab ich nicht hingekrigt aber ich probier weiter
Gruß


nach oben   nach unten

Re: funktioniert bei mir nicht
von: Thomas
Geschrieben am: 27.06.2002 - 09:38:25

Sorry Olga
Hab wiedermal die falsche Olga erwischt

 nach oben

Beiträge aus den Excel-Beispielen zum Thema "statt ausschneiden Kopieren"