unten aufgeführtes Makro läuft eigentlich einwandfrei. Der Fehler ist, dass die übernommenen Werte aus Sheet 1 für "W" und "X" im falschen Format in Sheet 2 übertragen werden. Es ist in Sheet 1 in "W" 31.10.2007 und in "X" 60,00. Daraus wird beim übertragen in Sheet 2 10/31/2007 und $60,00
Für eine Idee oder idealerweise eine Lösung, 1000 Dank
Grüsse zum sonnigen Wochenende
Klaus
Sub test()
Dim C As Range
On Error Resume Next
Set C = Sheets(2).UsedRange.Find(What:=ActiveCell.Value, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If Not C Is Nothing Then
'Treffer, machwas
With Sheets(1).Range("A" & ActiveCell.Row & ": E" & ActiveCell.Row)
.Interior.ColorIndex = 6
Sheets(2).Range("A" & C.Row & ": E" & C.Row).Interior.ColorIndex = .Interior.ColorIndex
Sheets(2).Range("A" & C.Row & ": E" & C.Row).Value = .Value
End With
Application.Goto Sheets(1), True
' bis hier alles super
With Sheets(1).Range("W" & ActiveCell.Row & ": X" & ActiveCell.Row)
.Interior.ColorIndex = 6
Sheets(2).Range("W" & C.Row & ": X" & C.Row).Interior.ColorIndex = .Interior.ColorIndex
Sheets(2).Range("W" & C.Row & ": X" & C.Row).Value = .Value
End With
Application.Goto Sheets(1), True
ActiveCell.Offset(1, 0).Activate
Else
ActiveCell.Offset(1, 0).Activate
End If
On Error GoTo 0
End Sub