Code verändern, aber wie?
02.12.2003 20:00:22
RalfF
Sub aktual()
Application.ScreenUpdating = False For i = 1 To 3 Sheets(i).Activate Range("B11").Select Range(Selection, Selection.End(xlDown)).Select For Each cell In Selection If cell.Value > 99999 Then konto = cell.Value End If cell.Offset(0, -1).Value = konto Next Next i Dim y As Integer Sheets(4).Activate Range("a1").Activate For i = 1 To 3 Sheets(4).Activate ActiveCell.Offset(1, 0).Activate Sheets(i).Activate Range("B11").Select Range(Selection, Selection.End(xlDown)).Select For Each cell In Selection If cell.Offset(0, -1).Value > 99999 Then Sheets(4).Activate If ActiveCell.Offset(-1, 0).Value <> cell.Offset(0, -1).Value Then ActiveCell.Offset(-1, 1).Value = cell.Offset(-1, 2).Value If IsEmpty(cell.Offset(-1, 3).Value) = False Then ActiveCell.Offset(-1, 1).Value = cell.Offset(-1, 3).Value End If ActiveCell.Value = cell.Offset(0, -1).Value ActiveCell.Offset(1, 0).Activate End If If ActiveCell.Offset(-1, 0).Value = cell.Offset(0, -1).Value Then If IsEmpty(cell.Offset(0, 3).Value) = True Then ActiveCell.Offset(-1, 1).Value = cell.Offset(0, 2).Value End If If IsEmpty(cell.Offset(0, 3).Value) = False Then ActiveCell.Offset(-1, 1).Value = cell.Offset(0, 3).Value End If End If Sheets(i).Activate ActiveCell.Offset(1, 0).Activate End If Next Next i For i = 1 To 3 Sheets(i).Activate Range("B11").Select Range(Selection, Selection.End(xlDown)).Select For Each cell In Selection If cell.Value > 99999 Then konto = cell.Value End If cell.Offset(0, -1).ClearContents Next Next i Application.ScreenUpdating = True End
Sub