VBA Schleifen! Dringend Hilfe benötigt!

[LB1308]

Hallo!

Folgendes möchte ich erreichen:

Ab Spalte F soll ein je nach Datei in der Größe variierender Zellbereich kopiert werden und daneben wieder eingefügt werden.
Das klappt schonmal.
Dann sollen die eingefügten Zeilen aber je mit einem Wert in Spalte D addiert werden.
Sprich: alle Werte der Zeile 8 sollen mit dem Wert in "F8" addiert werden,
alle Werte der Zeile 9 mit dem Wert in "F9" usw.
Das soll bis zur letzten beschrieben Zeile so weiter gehen.
Momentan sieht es so aus:

Range("F8").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy

ActiveSheet.Cells(8, ActiveSheet.UsedRange.Columns.Count + 2).PasteSpecial

For Each Cell In Selection
Cell.Value = Cell.Value + Range("$D$8").Value
Next

Ich bin für jeden Tip dankbar!!

Viele Grüße

 

[Yaslaw]

Ein Teil des Makros wurde aufgezeichnet. Scheusslicher Code.
Weg von .Select! Das verwendet man nicht, gibt nur Chaos.
Das ist bei dir der Fall. Du rechnest mit allen Werten in .Selection. .Selection ist aber die Quelle sein und nicht das Ziel der Kopierübung!

    Dim ws As Worksheet
    Dim rngStart As Range
    Dim rngSrc As Range
    Dim rngCell As Range
    Dim rngAddition As Range
    Dim colLast As Integer
    Dim colDelta As Integer
  
    Set ws = ActiveSheet
  
    Set rngStart = ws.Range("F8")
    Set rngAddition = ws.Range("D8")
  
    'Letzte Spalte der Zeile ermitteln
    colLast = xlsGetLastColumn(ws.Rows(rngStart.Row))
  
    'QuellRange ermitteln
    Set rngSrc = ws.Range(rngStart, ws.Cells(rngStart.Row, colLast))
  
    'Delta der Spalten berechnen
    colDelta = colLast - rngStart.Column + 2
  
    'Für alle Zellen des QuellRanges
    For Each rngCell In rngSrc
        'Die Zelle um colDelta versetzt berechnen und abfüllen
        rngCell.Offset(0, colDelta).Value = rngCell.Value + rngAddition.Value
    Next

Nachtrag 18.07.2017 08:49: Scheint wohl doch nicht so dringend, wie im Titel geschrieben.