Copy und Paste mit Offset
27.02.2018 18:50:27
Brandner
ich habe folgenden Code:
Sub Leerzellen2()
Dim Bereich As Range, Zelle As Range
Set Bereich = ActiveSheet.Range("A5:D18000")
Dim Zeile As Integer
Dim x As Integer
Dim y As Variant
Dim z As Variant
x = Sheets("RVO").Range("A4").Value
For Each Zelle In Bereich.SpecialCells(xlCellTypeBlanks)
y = Zelle.Row
z = Cells(y - 1, 1).Value
Zeile = Sheets("RVO").Range("f18:f18000").Find(What:=z).Row
Sheets("RVO").Range(Cells(Zeile, 10), Cells(Zeile, 62 - x)).Copy
Sheets(k).Range(Cells(y, 5), Cells(y, 48)).Paste
Sheets(k).Cells(y, 1).Value = Sheets(k).Cells(y - 1, 1).Value
Next Zelle
End Sub
Ich komme bis zu der fett markierten Zeile.
Mein Problem ist das er mir das kopierte aus dem sheet "RVO" nicht in sheets(k) einfügt. Gleichzeitig habe ich noch das Problem das die Endspalte immer Spalte 48 ist. Spalte fünf sich aber bei jeder Aktualisierung um eine Spalte nach rechts beim einfügen bewegen soll.
Kann mir hier vllt jemand weiterhelfen?
Vielen Lieben Dank!
Hier wären noch meine anderen Codes die in dieser Arbeitsmappe ausgeführt werden:
Dim k As Integer
Sub execute()
Dim blatt As Variant
k = 3
Do While k Sheets(k).Activate
Call leerzeilen2
Call Leerzellen2
k = k + 1
Loop
End Sub
Sub leerzeilen2()
Dim i As Long
Dim lastrow As Long
lastrow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = lastrow To 3 Step -1
If ActiveSheet.Cells(i, 1).Value = "" Or ActiveSheet.Cells(i - 1, 1).Value = "" Then
ElseIf ActiveSheet.Cells(i, 1).Value ActiveSheet.Cells(i - 1, 1).Value Then
Rows(i).Insert
End If
Next i
End Sub