Sub AKTUEL()
'
' AKTUEL Makro
'
' Genvejstast:Ctrl+s
'spalt celler
'
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(21, 2)), TrailingMinusNumbers:=True
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(4, 2)), TrailingMinusNumbers:=True
'tilføj filter og skul kolonner
Rows("1:1").Select
Selection.AutoFilter
Columns("B:C").Select
Selection.EntireColumn.Hidden = True
ActiveWindow.ScrollColumn = 2
Columns("F:F").Select
Selection.EntireColumn.Hidden = True
Columns("J:J").Select
Selection.EntireColumn.Hidden = True
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
Columns("L:P").Select
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
Columns("L:Q").Select
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
Columns("L:AA").Select
Selection.EntireColumn.Hidden = True
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 1
Columns("E:E").Select
Selection.EntireColumn.Hidden = True
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
' Filter efter buffey
ActiveSheet.Range("$A$1:$AC$302").AutoFilter Field:=4, Criteria1:= _
"Buffycoat-EDTA"
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
("G1:G302"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.ScrollColumn = 2
' formater måned dag og år for udtræk
Columns("H:K").Select
Selection.NumberFormat = "m/d/yyyy h:mm"
Columns("AB:AB").Select
'indsæt kolonner og format time : mm
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("AB:AD").Select
Selection.NumberFormat = "h:mm"
' udregn tidsforskel og navngiv celler
Range("AB5").Select
ActiveCell.FormulaR1C1 = "=RC[-19]-RC[-20]"
Range("AC5").Select
ActiveCell.FormulaR1C1 = "=RC[-18]-RC[-20]"
Range("AD5").Select
ActiveCell.FormulaR1C1 = "=RC[-1]+RC[-2]"
Range("AB1").Select
ActiveCell.FormulaR1C1 = "Udt. Til modt."
Range("AC1").Select
ActiveCell.FormulaR1C1 = "Modt til i frys"
Range("AD1").Select
ActiveCell.FormulaR1C1 = "Total tid"
Range("AB5").Select
' Træk formular ned til end xlup.
Range("AB5:AD5").AutoFill Destination:=Range("AB5:AD" & Cells(Rows.Count, "k").End(xlUp).Row)
Columns("G:K").Select
Selection.EntireColumn.Hidden = True
Range("A1").Select
ActiveCell.CurrentRegion.Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets.Add
ActiveSheet.Paste
Columns("A:A").ColumnWidth = 20.56
Columns("A:A").ColumnWidth = 23.22
Columns("B:B").ColumnWidth = 10.56
Columns("C:C").ColumnWidth = 13.11
Columns("D:D").ColumnWidth = 12.78
Columns("E:E").ColumnWidth = 13.11
Columns("B:B").Select
Application.CutCopyMode = False
Selection.Cut
Columns("J:J").Select
Selection.Insert Shift:=xlToRight
Selection.ColumnWidth = 18
Range("B22").Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "Antal rækker"
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "Periode"
Range("A3").Select
ActiveCell.FormulaR1C1 = "procent pr række"
Range("A4").Select
' sorter
Rows("5:5").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("Ark1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Ark1").AutoFilter.Sort.SortFields.Add Key:=Range( _
"D5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Ark1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'akkummuleret
ActiveCell.FormulaR1C1 = "=100"
Range("B3").Select
ActiveCell.FormulaR1C1 = "=100/R[-1]C"
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E6").Select
ActiveCell.FormulaR1C1 = "=R[-3]C[-3]"
Range("E7").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+R[-4]C[-3]"
Range("E8").Select
Columns("E:E").Select
Selection.NumberFormat = "0.00"
Range("E7").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+R3C2"
Range("E8").Select
Range("E5").Select
ActiveCell.FormulaR1C1 = "Akkummuleret procent"
Range("E6").Select
Columns("E:E").ColumnWidth = 20.78
Columns("E:E").Select
Selection.NumberFormat = "0"
' filldown Makro
Range("D7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.filldown
' format af procent
Range("B3").Select
Selection.NumberFormat = "0.00"
End Sub