ich möchte aus einer Excel-Datei (WbDatei1) das Makro starten und eine andere Datei öffnen (das funktioniert so weit recht gut). Nun sollen in der geöffneten Datei die Spalten gemäss Array-Vorgabe sortiert werden und die restlichen Spalten sollen gelöscht werden. Die Spaltensortierung funktioniert leider nicht.
Am Ende wird das Excel-File noch entsprechend formatiert. Das funktioniert glaub ich auch gut :-)
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
Ich danke euch für eure Hilfe.
Gruss
Andreas