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