Anzeige
Archiv - Navigation
128to132
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
128to132
128to132
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

statt ausschneiden Kopieren

statt ausschneiden Kopieren
25.06.2002 16:28:56
olga
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

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: statt ausschneiden Kopieren
25.06.2002 16:45:05
Michael Scheffler
Hallo Olga,

wie wäre es, wenn Du die Zeile

auskommentierst?

Gruß

Micha


funktioniert bei mir nicht
25.06.2002 17:09:18
olga
Ich habe es probiert und dies koppt bei mir nicht.
Re: funktioniert bei mir nicht
25.06.2002 20:41:17
Thomas
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ß

Anzeige
Re: funktioniert bei mir nicht
26.06.2002 17:30:00
olga
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

Re: funktioniert bei mir nicht
27.06.2002 08:21:01
Thomas
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ß

Anzeige
Re: funktioniert bei mir nicht
27.06.2002 09:38:25
Thomas
Sorry Olga
Hab wiedermal die falsche Olga erwischt

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige