Spalten in einer and. Datei nach Vorgabe sortieren

Public Sub CommandButtonTest_Click()
Dim WbDatei1 As String
Dim strFilter As String
Dim strFileName As Variant
Dim Pfad As String
Dim wb As Workbook
Dim ws As Worksheet
Dim strSearch As Variant
Dim intColumn As Integer
Dim bytCounter As Byte
Dim rngGefunden As Range
WbDatei1 = ActiveWorkbook.Name
'** Laufwerk und Pfad definieren, welcher geöffnet werden soll
Pfad = "\\szh.loc\ewz\orga\w\WT\2_Beschaffung\20_Ab- und Berechnungen\201_Kontrolle_ISU\" '  _
muss noch angegeben werden
'** Dateifilter definieren
strFilter = "Excel-Dateien(*.xls*), *.xls*"
'** Den im Dialogfeld gewählten Namen auslesen
Set fd = Application.FileDialog(msoFileDialogOpen)
fd.InitialFileName = Pfad & Year(Now()) & "\offen Posten zur Zahlung\"
If fd.Show  -1 Then
Exit Sub
End If
strFileName = fd.SelectedItems(1)
Set ws = Workbooks.Open(strFileName).Sheets("Format")
ws.Activate
Application.ScreenUpdating = False
Sheets("Format").Select
strSearch = Array("Betrag", "Tariftyp", "Steuerkennzeichen", "MwSt.-Nr.", "Abrechnungsdatum", " _
Druckbelegnummer", _
"Adresse Partner", "Name Partner", "Vertragskonto", "Geschäftspartner")    ' Die einzelnen  _
Spalten werden in umgekehrter Reihenfolge in ein Array geschrieben
For bytCounter = LBound(strSearch) To UBound(strSearch)
Set rngGefunden = Rows("1:1").Find(What:=strSearch(bytCounter), _
After:=Cells(1, Columns.Count), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If Not rngGefunden Is Nothing Then
If rngGefunden.Columns  bytCounter + 1 Then
Columns(rngGefunden.Columns).Cut
Columns(bytCounter + 1).Insert Shift:=xlToRight
End If
Else
Columns(bytCounter + 1).Insert Shift:=xlToRight
Cells(1, bytCounter + 1) = strSearch(bytCounter)
End If
Next bytCounter
Application.CutCopyMode = False
ActiveSheet.Columns("K:Z").Delete       'restliche Spalten löschen
'Seite einrichten
With ActiveSheet.PageSetup              'Seite einrichten
preLayout = .Orientation
preZoom = .Zoom
.Orientation = xlLandscape              'Querformat
.FitToPagesWide = 1                     '1 Seite breit
.FitToPagesTall = False                 '"leer" hoch
.PrintTitleRows = "$1:$1"               ' Wiederholungszeilen oben
End With
Columns("A:J").EntireColumn.AutoFit     'Spaltenbreite automatisch anpassen
Application.ScreenUpdating = True
End Sub