Hallo nochmal, Dankeschön für die vielen Hilfestellungen. Ich komme aber mit den Tips einfach nicht zurecht.
Ich habe noch nie mit Makros gearbeitet und diese ganzen Befehle sind für mich komplett unverständlich, daher mache ich es sicher irgendwie falsch.
Code:
Sub Import_vorbereiten()
' Import_vorbereiten Macro
'Datei über Dialog Öffnen
Datei = Application.GetOpenFilename
If Datei = Empty Then Exit Sub
'wofür ist der 1.Befehl ??? wird er gebraucht??
ExecuteExcel4Macro "WINDOW.MOVE(16,-35,"""")"
Workbooks.Open Filename:=Datei
Cells.UnMerge 'verbundene Zellen auflösen
'Zeilen + Spalten löschen
Rows("1:13").Delete Shift:=xlUp
Columns("A:A").Delete Shift:=xlToLeft
'Spalten Breite einstellen
Columns("A:AW").ColumnWidth = 2.83
Columns("A:AW").ColumnWidth = 9.67
'** welche Sinn macht das Selektieren ???
' ausser zum Ansehen gibt es hier keine Funktion !!
Range("B:I,K:K,L:L,M:M,N:N,P:P,Q:Q,R:R,S:S").Select
Range("S1").Activate
ActiveWindow.SmallScroll ToRight:=5
Range("B:I,K:K,L:L,M:M,N:N,P:P,Q:Q,R:R,S:S,U:U,V:V,W:W,X:X").Select
Range("X1").Activate
ActiveWindow.SmallScroll ToRight:=13
Range("B:I,K:K,L:L,M:M,N:N,P:P,Q:Q,R:R,S:S,U:U,V:V,W:W,X:X,Z:Z,AA:AA," & _
"AB:AB,AC:AC,AE:AE,AF:AF,AG:AG,AH:AH,AJ:AJ,AK:AK,AL:AL,AM:AM,AN:AN,AO:AO").Select
Range("AO1").Activate
ActiveWindow.SmallScroll ToRight:=10
Union(Range("AV:AV,AW:AW,B:I,K:K,L:L,M:M,N:N,P:P,Q:Q,R:R,S:S,U:U,V:V,W:W,X:X,Z:Z,AA:AA,AB:AB," & _
"AC:AC,AE:AE,AF:AF,AG:AG,AH:AH,AJ:AJ,AK:AK,AL:AL,AM:AM,AN:AN,AO:AO,AQ:AQ,AR:AR,AS:AS"), _
Range("AT:AT,AU:AU")).Select
Range("AW1").Activate
ActiveWindow.SmallScroll ToRight:=12
Range("AW6").Select
ActiveWindow.SmallScroll ToRight:=-222
'** ganzer Block unnütze Funktionen, am besten löschen !!
'Spalten Bereich gezielt löschen
Range("B:B,C:C,D:D,E:E,F:F,G:G,H:H,I:I").Delete Shift:=xlToLeft
Range("C:C,D:D,E:E,F:F,H:H,I:I,J:J,K:K").Delete Shift:=xlToLeft
Range("E:E,F:F,G:G,H:H,J:J,K:K,L:L,M:M,O:O,P:P,Q:Q,R:R").Delete Shift:=xlToLeft
Range("H:H,I:I,J:J,K:K,L:L,M:M,O:O,P:P,Q:Q,R:R,S:S,T:T").Delete Shift:=xlToLeft
'Spalten + Zeilen löschen
Columns("I:X").Delete Shift:=xlToLeft
Rows("4:4").Delete Shift:=xlUp
Rows("1:2").Delete Shift:=xlUp
'Zeilenhöhe einstellen
Rows("1:7").RowHeight = 16
'Datei Vorgabe zum Speichern (oder Empty)
strDateiname = Import
'Datei über Dialog speichern
Application.Dialogs(xlDialogSaveAs).Show (strDateiname)
ActiveWindow.Close
Workbooks("Import vorbereiten.xlsm").Close False
Application.Quit
End Sub
Ein paar Dinge funktionieren noch nicht so richtig.
Zum einen würde ich den Dateinamen und die Endung definieren.
Außerdem sollte es automatisch abgespeichert werden ohne Frage an den Benutzer -> gewünscht währe da dass es genau an dem selben Ort gespeichert wird wo auch die OpenReport Datei liegt. Sprich egal auf welchem Computer ich arbeite dass der Pfad immer der der Open Report Datei ist.
Und am Ende nach dem Speichern (was manuell schon funktioniert) stürzt Excel allerdings komplett ab. Die Datei ist gespeichert aber trotzdem irritierend für den späteren Nutzer.
Ich weiß es ist viel verlangt aber wenn jemand Lust hat währe es cool wenn mir jemand den vollständigen Code schickt den Ich einfügen kann das währe wirklich super.