Spaltentausch ab Zeile X
27.07.2009 20:22:55
Erich
Hi Günter,
sorry, den Fehler habe ich auch gerade bemerkt,
als ich versucht habe, die Anzahl Überschriftzeilen vorzugeben.
Hier eine neue Version:
Option Explicit
Sub SpalteTauschAb2(nRechts As Boolean)
Dim lngU As Long, lngSpalteVon As Long, lngSpalteBis As Long
Dim lngR As Long, lngC As Long, lngA As Long, lngB As Long
Dim rng As Range, rngR As Range, arr As Variant
lngU = 1 ' Anzahl Überschriftzeilen
lngSpalteVon = 1 ' linkeste zulässige Spalte
lngSpalteBis = 20 ' rechteste zulässige Spalte
lngR = IIf(nRechts, 1, -1)
If lngSpalteVon lngU Then
Set rng = Cells(lngU + 1, lngC).Resize(lngA - lngU)
arr = rng ' Werte der aktuellen Spalte merken
End If
lngB = Cells(Rows.Count, lngC + lngR).End(xlUp).Row
If lngB > lngU Then
Set rngR = Cells(lngU + 1, lngC + lngR).Resize(lngB - lngU)
rngR.Offset(, -lngR) = rngR.Value ' aktuelle Spalte überschreiben
End If
If lngA > lngB Then _
Cells(lngB + 1, lngC).Resize(lngA - lngB).ClearContents ' Rest löschen
If Not rng Is Nothing Then _
rng.Offset(, lngR) = arr ' gemerkte Werte in andere Spalte
If lngA
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort