Code verändern, aber wie

Noch ein Versuch, ich habe schon einmal versucht Hilfe auf den unten stehenden Code zu bekommen, leider ohne Erfolg, hoffe das nun jemand diesen Hilferuf liest. Gruß, RalfF. Danke an PeterW

Hallo Exceler, ich habe ein Problem mit dem unten aufgeführten Code. Der ist
super in der Anwendung, sollte aber dennoch eine kleine Verbesserung
bekommen. Er holt aus den ersten 3 Blättern der Datei Daten und bringt sie
auf das 4te Dateiblatt. Soweit so gut. Kann man den Code (und wie?) so
ändern, das die Daten die auf das 4te Blatt gebracht werden, einen Abstand
von 15 Spalten bekommen? In der jetzigen Variante haben die Daten nur 1
Spalte als Leerzeile. Würde mich freuen wenn ihr dafür eine Lösung finden
könntet, ich selber habe keine rechte Ahnung über VB. Danke, Ralf


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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub test() 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 '******** hier 15 Leerzeilen = offset(Zeile,Spalte) ************* ActiveCell.Offset(15, 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

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread