AW: wenn Telefax dann zeile runter kopieren.
18.07.2005 10:25:46
Tales
Ok,ich musste weil ich mehr spalten hatte die range usw erweiter jetzt geht teil ein gut (findet immer die richtige zeile nur copiert er die nummer nicht sonder die ist dann weg)
hier die geänderte von mir also die nummer darf nicht weg sondern muss nur in spalte J kopiert werden dann gehts wie ich das wollte und nochmals danke ,gutes makro selten gesehen.
Dim c As Range
Dim ersterFundort As String
Dim gleich As Boolean
With Range("h:h")
Set c = .Find(What:="Telefax")
If Not (c Is Nothing) Then
ersterFundort = c.Address
Do
gleich = Vergleich_Zeile(c.Row, c.Row - 1)
If gleich Then
Cells(c.Row - 1, 9).Value = "'" & Cells(c.Row, 10).Value
Else
gleich = Vergleich_Zeile(c.Row, c.Row + 1)
If gleich Then
Cells(c.Row + 1, 9).Value = "'" & Cells(c.Row, 10).Value
End If
End If
Set c = .FindNext(c)
Loop While Not (c Is Nothing) And c.Address ersterFundort
End If
End With
End Sub
Public
Function Vergleich_Zeile(aktZeile As Long, Zeile As Long) As Boolean
Dim I As Integer
Vergleich_Zeile = True
For I = 1 To 6
If Cells(aktZeile, I).Value <> Cells(Zeile, I).Value Then
Vergleich_Zeile = False
Exit For
End If
Next I
End Function
