Option Explicit
Sub Inhalt_verschieben()
Dim temp As String
Dim iRow, iCol, swapCol As Integer
Application.ScreenUpdating = False
Sub swap(iRow As Integer, iCol As Integer, swapCol As Integer)
Do Until Cells(iRow, iCol) = " "
temp = Cells(iRow, iCol)
Cells(iRow, iCol) = Cells(iRow, swapCol)
Cells(iRow, swapCol) = temp
Loop
End Sub
Application.ScreenUpdating = True
End Sub
Es sollen also solange Zeilen verschoben werden, bis der zu kopierende Wert leer ist. Ich muss circa 20 Reihen kopieren und umbenennen,!