Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Ü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
Anzeige

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

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige