Sub drei()
Dim i As Integer, r As Integer
r = Range("A65536").End(xlUp).Offset(0, 0).Row
For i = 1 To r Step 1
If Cells(i, 1).Value = 3 Then
Cells(i, 2).Value = 3
Cells(i + 1, 2).Value = 3
Else
If Cells(i, 2).Value 3 Then
Cells(i, 2).Value = Cells(i, 1).Value
End If
End If
Next i
End Sub
Diesen Code in das jeweilige Tabellenmodul(Alt+F11 und z.B. Tabelle1)
Gruß
Chaos
Sub drei()
Dim i As Integer, r As Integer
Dim n As String, t As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
t = ActiveSheet.Name
r = Sheets(t).Range("A65536").End(xlUp).Offset(0, 0).Row
Sheets(t).Range("A1:A" & r).Copy
Sheets.Add
n = ActiveSheet.Name
Sheets(n).Range("A1").Insert
For i = 1 To r Step 1
If Sheets(n).Cells(i, 1).Value = 3 Then
Sheets(n).Cells(i, 2).Value = 3
Sheets(n).Cells(i + 1, 2).Value = 3
Else
If Sheets(n).Cells(i, 2).Value 3 Then
Sheets(n).Cells(i, 2).Value = Cells(i, 1).Value
End If
End If
Next i
Sheets(n).Range("B1:B" & r).Copy Destination:=Sheets(t).Range("A1")
Sheets(n).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Gruß
Chaos