Thema Datum  Von Nutzer Rating
Antwort
Rot Makro macht nicht was es soll, keine Fehlermeldung
 13.10.2006 16:40:32 Roberto
NotSolved
15.10.2006 03:33:29 Rasta
NotSolved
15.10.2006 16:49:15 Roberto
NotSolved
16.10.2006 08:06:39 Rasta
NotSolved
31.10.2012 12:47:26 Gast23366
NotSolved

Ansicht des Beitrags:
Von:
Roberto		 Datum:
13.10.2006 16:40:32		 Views:
2455		 Rating:
     
Antwort:
  Ja
Thema:
Makro macht nicht was es soll, keine Fehlermeldung
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

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Makro macht nicht was es soll, keine Fehlermeldung
 13.10.2006 16:40:32 Roberto
NotSolved
15.10.2006 03:33:29 Rasta
NotSolved
15.10.2006 16:49:15 Roberto
NotSolved
16.10.2006 08:06:39 Rasta
NotSolved
31.10.2012 12:47:26 Gast23366
NotSolved