|
sry, Button Code vergessen
Option Explicit
Sub RepIt()
Dim rngUs As Range, rngCl As Range
Set rngUs = ColRange()
'On Error Resume Next
For Each rngCl In rngUs.Cells
If rngCl.Offset(-1).Value <> "" And rngCl.Offset(-1).Value = "x" Then _
rngCl.Value = rngCl.Offset(-1).Value
Next rngCl
On Error GoTo 0
End Sub
Function ColRange() As Range
Dim rngFc As Range, rngCc As Range, strRs As String
Application.FindFormat.Clear
Application.FindFormat.Interior.ColorIndex = 36
Set rngFc = Cells.Find(What:="", After:=Cells(1, 1), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True)
If Not rngFc Is Nothing Then
Set rngCc = rngFc
Do
strRs = strRs & rngCc.Address & ","
Set rngCc = Cells.Find(What:="", After:=rngCc, _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=True)
Loop Until rngCc.Address = rngFc.Address
strRs = Replace(Left(strRs, Len(strRs) - 1), "$", "")
Set ColRange = Range(strRs)
End If
Application.FindFormat.Clear
End Function
|