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
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen