Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1620to1624
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA - Spalten neu verteilen

VBA - Spalten neu verteilen
01.05.2018 13:12:44
WalterK
Hallo,
ich suche eine Makrolösung für folgendes Szenario:
Im Beispiel gibt es 4 Spalten (A:D) mit Daten, es können auch viel mehr sein.
Die Überschriften sind in Zeile 2.
In Zeile 1 schreibe ich die gewünschte Spaltennummer in der die Daten später sein sollen.
Das Makro soll nun die Spalten in die gewünschte Spalte kopieren. Die Spalten dazwischen bleiben einfach leer.
Besten Dank im voraus, Servus Walter


Tabelle1
 ABCDE
1131011 
2Über1Über2Über3Über4 
31111 
42222 
53333 
64444 
75555 
86666 
97777 
108888 
11     
12     

http://excel-inn.de/dateien/vba_beispiele/tabellenanzeige_in_html_addin.zip
http://hajo-excel.de/tools.htm
XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007
Add-In-Version 14.15 einschl 64 Bit

https://www.herber.de/bbs/user/121376.xlsx

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA - Spalten neu verteilen
01.05.2018 13:37:00
Gerd
Servus Walter,
als Grundlage.
Sub Spalten_kopieren()
Dim X As Long
For X = 1 To Cells(2, Columns.Count).End(xlToLeft).Column
If IsNumeric(Cells(1, X).Text) Then
If Cells(1, X) > 0 Then
If Cells(1, X)  X Then
Columns(X).Copy Columns(Cells(X, 1))
End If
End If
End If
End If
Next
End Sub

Gruß Gerd
AW: ups
01.05.2018 13:42:27
Gerd

Sub Spalten_kopieren2()
Dim X As Long
For X = 1 To Cells(2, Columns.Count).End(xlToLeft).Column
If IsNumeric(Cells(1, X).Text) Then
If Cells(1, X) > 0 Then
If Cells(1, X)  X Then
Columns(X).Copy Columns(Cells(1, X))
End If
End If
End If
End If
Next
End Sub

Anzeige
noch nicht ganz
01.05.2018 21:17:45
WalterK
Hallo Gerd,
so passt es noch nicht ganz.
Beim folgenden Beispiel wird die zu kopierende Spalte D überschrieben bevor ich sie in die Spalte 11 kopieren kann.
Servus, Walter
Ich habe das Beispiel als xlsx gespeichert.
https://www.herber.de/bbs/user/121386.xlsx
AW: Schleife rueckwaerts
02.05.2018 09:23:26
hary
Moin Walter
Hab mal den Code von Gerd aufgenommen. Lass mal die Schleife von hnten durchlaufen.
Dim X As Long
For X = Cells(2, Columns.Count).End(xlToLeft).Column To 1 Step -1
If IsNumeric(Cells(1, X).Text) Then
If Cells(1, X) > 0 Then
If Cells(1, X)  X Then
Columns(X).Copy Columns(Cells(1, X))
End If
End If
End If
End If
Next

gruss hary
Anzeige
AW: Schleife rueckwaerts
02.05.2018 15:01:22
WalterK
Hallo hary,
tja, so gehts auch nicht.
Wenn z.B. in Zeile 1 die Spaltennummern so lauten 3 - 1 - 10 - 11 wird die Spalte A:A beim Makrodurchlauf überschrieben und die Daten sind dann weg.
Trotzdem Danke.
Der Code von Robert funktioniert.
Servus, Walter
AW: noch nicht ganz
02.05.2018 09:48:03
Robert
Hallo Walter,
nachstehendes Makro kopiert die Spalten rechts neben den bisherigen Datenbereich gemäß den Eintragungen in der 1. Zeile und löscht anschließend den alten Datenbereich. Als Ergebnis müssten die Daten in den gewünschten Spalten stehen.
Sub SpaltenSortieren()
Dim lMaxSpalte As Long, n As Long
lMaxSpalte = Cells(1, Columns.Count).End(xlToLeft).Column
For n = 1 To lMaxSpalte
Columns(n).Copy Destination:=Columns(Cells(1, n) + lMaxSpalte)
Next
Range(Columns(1), Columns(lMaxSpalte)).Delete Shift:=xlToLeft
End Sub
Gruß
Robert
Anzeige
Danke Robert, so passt es. Servus, Walter
02.05.2018 15:02:11
WalterK
Gerne und Danke für die Rückmeldung (owT)
02.05.2018 16:32:14
Robert

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige