Hallo,
ich habe mir ein kleines Makro geschrieben, mit dem ich von einer Excel-Mappe aus, andere Mappen aufrufen kann und den Inhalt der Aufgerufenen ein wenig bearbeitet.
Das Makro läuft auch prima ohnen Fehlermeldung durch, allerdings führt es nicht alles aus, was es machen soll. Vielleicht erkennt jemand den Fehler.
Die Befehle unter folgenden Kommentaren werden nicht ausgeführt.
'Rahmen bis letzte Spalte einfügen
'Gruppierungen schließen
'Fenster fixieren
'Layout
Makro lautet:
Sub KLVER_Datenaufbereitung()
Dim S As String
Dim B As String
'auslesen Speicherort
S = Workbooks("Auswertung KLVER Makro").Path
'633388 anpassen
B = "\633388.xls"
Workbooks.Open S + B
ActiveWorkbook.Sheets("Tabelle3").Select
'Einfügen neues Tabellenblatt
'Sheets("Tabelle3").Select
ActiveWorkbook.Sheets.Add
ActiveWorkbook.Sheets("Tabelle2").Select
ActiveWorkbook.Sheets("Tabelle2").Name = "Auswertung_KLVER"
Range("A1").Select
'Kopieren der "Rohdaten"
ActiveWorkbook.Sheets("Tabelle1").Select
Cells.Select
Selection.Copy
ActiveWorkbook.Sheets("Auswertung_KLVER").Select
Range("A1").Select
ActiveWorkbook.ActiveSheet.Paste
'Format einstellen
Cells.Select
Selection.NumberFormat = "0"
'Auswertung erstellen
ActiveWorkbook.Sheets("Auswertung_KLVER").Select
Range("A1:A2").Select
Selection.ClearContents
Range("A1").Select
ActiveCell.FormulaR1C1 = "Buchungs-"
Range("A2").Select
ActiveCell.FormulaR1C1 = "periode"
Range("B1:B2").Select
Selection.ClearContents
Range("B1").Select
ActiveCell.FormulaR1C1 = "Rechnungsnr."
Range("C1:C2").Select
Selection.ClearContents
Range("C1").Select
ActiveCell.FormulaR1C1 = "Herkunft"
Range("C2").Select
ActiveCell.FormulaR1C1 = "Bahnstelle"
Range("D1:D2").Select
Selection.ClearContents
Range("D1").Select
ActiveCell.FormulaR1C1 = "Herkunft"
Range("D2").Select
ActiveCell.FormulaR1C1 = "Rkost/AAR-Nr."
Range("E1:E2").Select
Selection.ClearContents
Range("E1").Select
ActiveCell.FormulaR1C1 = "Belastung"
Range("E2").Select
ActiveCell.FormulaR1C1 = "Bahnstelle"
Range("F1:F2").Select
Selection.ClearContents
Range("F1").Select
ActiveCell.FormulaR1C1 = "Belastung"
Range("F2").Select
ActiveCell.FormulaR1C1 = "Rkost/AAR-Nr."
'Löschen der Zellinhalte "'"
Cells.Replace What:="'", Replacement:="", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("I1:I2").Select
Selection.ClearContents
Range("I1").Select
ActiveCell.FormulaR1C1 = "Bezeichnung1"
Range("J1:J2").Select
Selection.ClearContents
Range("J1").Select
ActiveCell.FormulaR1C1 = "Bezeichnung2"
'Ausschneiden und einfügen
Columns("M:M").Select
Application.CutCopyMode = False
Selection.Cut
Columns("I:I").Select
Selection.Insert Shift:=xlToRight
'Ausschneiden und einfügen
Columns("L:L").Select
Application.CutCopyMode = False
Selection.Cut
Columns("J:J").Select
Selection.Insert Shift:=xlToRight
Columns("Y:Y").Select
Application.CutCopyMode = False
Selection.Cut
Columns("K:K").Select
Selection.Insert Shift:=xlToRight
Columns("S:S").Select
Application.CutCopyMode = False
Selection.Cut
Columns("N:N").Select
Selection.Insert Shift:=xlToRight
Range("K1:K2").Select
Selection.ClearContents
Range("K1").Select
ActiveCell.FormulaR1C1 = "Verrechnungs-"
Range("K2").Select
ActiveCell.FormulaR1C1 = "betrag in €"
'Format Zahl
Columns("K:K").Select
Selection.NumberFormat = "#,##0.00"
Range("N1:N2").Select
Selection.ClearContents
Range("N1").Select
ActiveCell.FormulaR1C1 = "sachl. OK?"
Range("A1:CS2").Select
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 44
.Pattern = xlSolid
End With
'Rahmen bis letzte Spalte einfügen
Range("A1:A2").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A1:A2").Select
Selection.Copy
Range("B1:CS2").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Cells.Select
Cells.EntireColumn.AutoFit
Columns("B:D").Select
Selection.Columns.Group
Columns("G:H").Select
Selection.Columns.Group
Columns("O:CS").Select
Selection.Columns.Group
Columns("L:L").Select
Columns.AutoFit
'Gruppierungen schließen
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
ActiveWindow.Zoom = 90
'Autofilter
Range("A1:N2").Select
Selection.AutoFilter
'Fenster fixieren
Rows("3:3").Select
ActiveWindow.FreezePanes = True
'Layout
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "&D"
.CenterFooter = "&A"
.RightFooter = "I.NF-O-L 1 (PS)"
.LeftMargin = Application.InchesToPoints(0.196850393700787)
.RightMargin = Application.InchesToPoints(0.196850393700787)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0.118110236220472)
.FooterMargin = Application.InchesToPoints(0.118110236220472)
.PrintHeadings = False
.PrintGridlines = True
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
'Abfrage einfügen wie viele Seiten
.FitToPagesWide = 1
.FitToPagesTall = 2
.PrintTitleRows = "$1:$2"
.PrintErrors = xlPrintErrorsDisplayed
End With
Range("A1").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
|