Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1600to1604
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

Überschriften in 2 Tabellen sortieren

Überschriften in 2 Tabellen sortieren
11.01.2018 10:28:17
dove
Hallo zusammen,
ich habe folgendes Problem.
Ich arbeite in 2 Tabellenblättern, welche gleiche Spaltenüberschriften haben, allerdings in unterschiedlicher Reihenfolge.
Also z.B. Tabelle 1, Spalte A = Name, Spalte B = Wohnort usw. und in Tabelle 2 Spalte G = Name, Spalte I = Wohnort
Gibt es eine Möglichkeit per VBA die Spaltenüberschriften auszulesen und die Spalten in Tabelle 2 in der Reihenfolge anzuordnen wie in Tabelle 1?
Bitte nur Lösungen via VBA aufzeigen.
Vielen Dank im Voraus
LG Dove

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Überschriften in 2 Tabellen sortieren
11.01.2018 12:18:14
Michael
Hallo!
Etwa so:
Sub a()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1")
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle2")
Dim h As Range, f As Range, c As Range, Reihe, i&
Application.ScreenUpdating = False
With WsQ
Set h = .Range(.Cells(1, 1), .Cells(1, .Columns.Count).End(xlToLeft))
ReDim Reihe(1 To h.Cells.Count)
For i = 1 To h.Cells.Count
Reihe(i) = h(i).Value
Next i
With WsZ
For i = 1 To h.Cells.Count
.Columns(1).Insert shift:=xlToRight
Next i
Set h = .Range(.Cells(1, h.Cells.Count), _
.Cells(1, .Columns.Count).End(xlToLeft))
For i = UBound(Reihe) To LBound(Reihe) Step -1
Set f = h.Find(Reihe(i), LookIn:=xlValues, lookat:=xlWhole)
If Not f Is Nothing Then
Set c = .Range(f, .Cells(.Rows.Count, f.Column).End(xlUp))
c.Cut: .Columns(1).Insert
Set c = Nothing: Set f = Nothing
End If
Next i
.Activate: .Cells(1, 1).Select
End With
End With
Set Wb = Nothing: Set WsQ = Nothing: Set WsZ = Nothing
Set h = Nothing: Erase Reihe
End Sub
Anpassungen auf Deine Gegebenheiten bekommst Du hin?
LG
Michael
Anzeige

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige