AW: Makrorekorder
04.07.2007 08:56:00
Steve
Hallo Hajo,
ich habe ein Teil der Exceldatei hochgeladen, und hier ist mein Makro programm code:
Sub ERI_PREISE_EKN_I()
' ERI_PREISE_EKN_I Makro
' Makro am 03.07.2007 von SVA aufgezeichnet
ChDir "C:\DOS"
Workbooks.Open Filename:="C:\DOS\91314.xls"
ActiveWindow.SmallScroll Down:=-15
Columns("D:E").Select
Selection.Delete Shift:=xlToLeft
Columns("E:F").Select
Selection.Delete Shift:=xlToLeft
Columns("G:G").Select
Selection.Delete Shift:=xlToLeft
Columns("H:K").Select
Selection.Delete Shift:=xlToLeft
Columns("H:H").Select
Selection.Delete Shift:=xlToLeft
Range("I9").Select
ActiveWindow.SmallScroll ToRight:=4
Columns("I:Q").Select
Selection.Delete Shift:=xlToLeft
Columns("J:P").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("J:M").Select
Selection.Delete Shift:=xlToLeft
Columns("J:J").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("K:R").Select
Selection.Delete Shift:=xlToLeft
Range("A1:J1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Cells.Select
Selection.AutoFilter
Range("J4").Select
Selection.AutoFilter Field:=10, Criteria1:="="
Range("B88").Select
ActiveWindow.SmallScroll Down:=-15
Range("A43655").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range("A1:J81").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=9
Selection.Copy
Workbooks.Add
Cells.Select
ActiveSheet.Paste
Cells.Select
Application.CutCopyMode = False
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Cells.EntireColumn.AutoFit
Range("C2").Select
ActiveWindow.FreezePanes = True
ActiveWindow.SmallScroll Down:=-9
Columns("F:F").Select
Selection.Insert Shift:=xlToRight
Range("F1").Select
ActiveCell.FormulaR1C1 = "EKN (DB1)"
Range("F2").Select
Columns("F:F").EntireColumn.AutoFit
Columns("F:F").ColumnWidth = 10.22
Cells.Select
Selection.AutoFilter
Range("F6").Select
ActiveWindow.SmallScroll ToRight:=0
Range("I5").Select
Selection.AutoFilter Field:=7, Criteria1:="BISI01"
Selection.AutoFilter Field:=10, Criteria1:="11341"
ActiveWindow.SmallScroll Down:=-9
Range("E3494").Select
ActiveCell.FormulaR1C1 = "35"
Range("E3494").Select
Selection.FillDown
Range("F3494").Select
Selection.AutoFilter Field:=10, Criteria1:="11311"
Range("E3411").Select
ActiveWindow.SmallScroll Down:=-6
ActiveCell.FormulaR1C1 = "35"
Range("E3411").Select
Selection.FillDown
Range("F3414").Select
Selection.AutoFilter Field:=10, Criteria1:="11321"
Range("F3742").Select
ActiveWindow.SmallScroll Down:=-15
Range("E3738").Select
ActiveCell.FormulaR1C1 = "35"
Range("E3738").Select
Selection.FillDown
Range("F3738").Select
Selection.AutoFilter Field:=10, Criteria1:="11331"
Range("H3772").Select
ActiveWindow.SmallScroll Down:=-9
Range("E3769").Select
ActiveCell.FormulaR1C1 = "35"
Range("E3769").Select
Selection.FillDown
Range("F3771").Select
Selection.AutoFilter Field:=10, Criteria1:="17511"
Range("F3397").Select
ActiveWindow.SmallScroll Down:=-12
Selection.AutoFilter Field:=9, Criteria1:="085"
Range("E4548").Select
ActiveCell.FormulaR1C1 = "35"
Range("E4548").Select
Selection.FillDown
Range("F4550").Select
Selection.AutoFilter Field:=9
Range("I3394").Select
Selection.AutoFilter Field:=10, Criteria1:="17711"
Range("F4608").Select
ActiveWindow.SmallScroll Down:=-12
Range("E4599").Select
ActiveCell.FormulaR1C1 = "35"
Range("E4599").Select
Selection.FillDown
Range("F4600").Select
Selection.AutoFilter Field:=10, Criteria1:="17721"
Range("E4623").Select
ActiveCell.FormulaR1C1 = "35"
Range("E4623").Select
Selection.FillDown
Range("F4627").Select
Selection.AutoFilter Field:=10
Selection.AutoFilter Field:=7
Columns("F:F").ColumnWidth = 13
Range("F2").Select
ActiveCell.FormulaR1C1 = "=(RC[-2]*RC[-1])/100"
Range("F2").Select
Selection.AutoFill Destination:=Range("F2:F27387")
Range("F2:F27387").Select
Range("F4").Select
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Range("F1").Select
Selection.Copy
Range("G1").Select
ActiveSheet.Paste
Range("G2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
Range("G2").Select
Columns("F:F").EntireColumn.AutoFit
Columns("H:H").Select
Selection.Insert Shift:=xlToRight
Range("H1").Select
ActiveCell.FormulaR1C1 = "VK-Netto"
Range("B2").Select
ActiveWorkbook.SaveAs Filename:="C:\DOS\Mappe2.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
End Sub
____________________________________________________
Danke Steve