Guten Morgen zusammen!
Habe mal wieder ein Problem. Ich habe meine Datenblätter bedingt
formatiert für die Übersichtlichkeit. Jede zweite Zeile ist nun bunt.
Mit einem VBA- Code kopieren ich Zeilen von Tabellenblatt 1 nach
Tabellenblatt 2. Nun möchte ich, dass nur die daten und nicht die
Formatierung kopiert werden. Im Moment klappt das nicht. So
bekomme ich nun ein paar Zeilen bunt, dann wieder mehrere weiß,
usw. Wenn die die Zeile wieder zurück schicke, in Tabellenblatt 1,
dann habe ich wieder den selben effekt.
Die Formatierung habe ich nicht mit VBA gemacht. Wäre das die
Lösung? und wie würde das aussehen. Hier ist nochmal mein Code
'Rückgabe der Zeile zur Bestellung per Doppelklick'
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range,
Cancel As Boolean)
Dim Bereich As Range
Dim lrow, zRow As Long
lrow = Sheets("Bestellungen").Range("A65536").End(xlUp).Row + 1
zRow = Sheets("Lieferung").Range("A65536").End(xlUp).Row
Set Bereich = Sheets("Lieferung").Range("O2:O" & zRow) '*** hier
eintragen wo das Datum steht
If Not Intersect(Target, Bereich) Is Nothing Then
Application.EnableEvents = False
If IsDate(Target.Value) = True And Target.Value <> "" Then
With Range("A" & Target.Row & ":O" & Target.Row) '*** hier
eintragen was zurückgegeben werden soll
Sheets(2).Range("N" & Target.Row).Value = ""
.Copy Destination:=Sheets("Bestellungen").Range("A" & lrow)
.Delete Shift:=xlShiftUp
End With
End If
End If
Application.EnableEvents = True
Cancel = True
Tabelle7.Sortieren lrow
End Sub
'per Datumsbestätigung die Lieferung zur Installation schicken'
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Dim lrow, zRow As Long
On Error GoTo FehlerHandler
lrow = Sheets("Lieferung").Range("A65536").End(xlUp).Row
zRow = Sheets("Installation").Range("A65536").End(xlUp).Row + 1
Set Bereich = Sheets("Lieferung").Range("P2:P" & lrow) '*** hier
eintragen wo das Datum steht
If Not Intersect(Target, Bereich) Is Nothing Then
If IsDate(Target.Value) = True And Target.Value <> "" Then
With Range("A" & Target.Row & ":P" & Target.Row) '*** hier
eintragen was kopiert werden soll
.Copy Destination:=Sheets("Installation").Range("A" & zRow)
Application.EnableEvents = False
.Delete Shift:=xlShiftUp
End With
End If
End If
Application.EnableEvents = True
Exit Sub
FehlerHandler:
Call x
End Sub
Public Sub Sortieren(ByVal lrow As Long)
Sheets("Lieferung").Range("A2:P" & lrow).Sort Key1:=Range("A2"),
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sheets("Lieferung").Select
End Sub
Sub x()
Application.EnableEvents = True
End Sub
Vielen Dank
Grüße
Nicole
