ich möchte alle Spalten löschen, außer drei Spalten mit spezieller Überschrift. Diese drei Spalten sollen im Tabellenblatt bei A, B und C angeordnet werden.
Wie ist das möglich?
Gruß Filip
Sub Spalten_weg()
Dim LC As Integer, Z1 As Integer, i As Integer
Z1 = 1 'Zeile mit Überschrift
LC = Cells(Z1, Columns.Count).End(xlToLeft).Column 'letzte Spalte einer Zeile
For i = LC To 1 Step -1
Select Case Cells(Z1, i)
Case "Ja", "Yes", "CCC" ' Die 3 die Übrig bleiben sollen
'mach nichts
Case Else
Columns(i).Delete xlLeft
End Select
Next
End Sub
Sub Spalten_weg()
Dim LC As Integer, Z1 As Integer, i As Integer
Dim RF(), Bl, Sp As Integer
'####Vorgaben
RF = Array("Ja", "Yes", "CCC", "h") 'Reihenfolge
Z1 = 1 'Zeile mit Überschrift
'######
LC = Cells(Z1, Columns.Count).End(xlToLeft).Column 'letzte Spalte einer Zeile
For i = LC To 1 Step -1
Select Case True
Case Cells(Z1, i) <> "" And InStr(Join(RF, "#"), Cells(Z1, i)) > 0
'mach nichts
Case Else
Columns(i).Delete xlLeft
End Select
Next
'Sortieren nach der Arrayreihenfolge
For Bl = Ubound(RF) To Lbound(RF) Step -1
If WorksheetFunction.CountIf(Rows(Z1), RF(Bl)) > 0 Then ' falls eine Überschrift im Array, aber trotzdem nicht vorhanden ist
Sp = WorksheetFunction.Match(RF(Bl), Rows(Z1), 0) 'Spalte finden
'immer als Erste Spalte festlegen
If Sp <> 1 Then
Columns(Sp).Cut
Columns(1).Insert Shift:=xlToRight
End If
End If
Next
End Sub