Hallo!
kann mir jemand sagen, wo eventuell ein runtime error nr.9 sein könnte.
Ich weiß ja nicht, ob man das erkennt und wie man den raus bekommen könnte.
Wenn es zu viel ist, dann lasst es lieber sein.
Danke schon mal im Vorraus für eure Hilfe.
Sub FC()
Dim FN As Variant
Dim i As Integer
i = 0
[e9].Select
Do
FN = [festplatte] & ActiveCell
Application.Workbooks.Open FN
Application.ScreenUpdating = True
' check whether update already done
'All Worksheets visible
Dim wksWorksheet As Worksheet
For Each wksWorksheet In ActiveWorkbook.Worksheets
If wksWorksheet.Visible <> xlSheetVisible Then
wksWorksheet.Visible = xlSheetVisible
Debug.Print wksWorksheet.Name & " wurde eingeblendet"
End If
Next wksWorksheet
' All Worksheets unprotected
For Each wksWorksheet In ActiveWorkbook.Sheets
wksWorksheet.Unprotect Password:="Reporting"
Next wksWorksheet
' change the version number
Sheets("Cover Sheet").Select
Range("G3") = "v1.0"
Range("E5") = "FC I"
Dim CountryName As Variant
Sheets("Cover Sheet").Select
CountryName = Range("B4").Formula
' change the deviations and the years in the Lists Sheet
Sheets("Lists").Select
Range("C19") = "2008"
Range("C20") = "2009"
Range("C21") = "2010"
Range("C22") = "2011"
Range("C23") = "2007"
Range("A52") = "FC I - ACT 07"
Range("A53") = "FC II - ACT 07"
Range("A54") = "FC III - ACT 07"
Range("A55") = "FC IV - ACT 07"
' change the years in the data sheet
Sheets("data").Select
Range("C3") = "2007"
Range("G3") = "2008"
' rename the sheets
Sheets("FC 07 (LC)").Name = "FC 08 (LC)"
Sheets("FC 07 (EUR)").Name = "FC 08 (EUR)"
Sheets("BD 08-10 (LC)").Name = "BD 09-11 (LC)"
Sheets("BD 08-10 (EUR)").Name = "BD 09-11 (EUR)"
' Copy FC IV to FC I until FC III
Sheets("FC 08 (LC)").Select
Range("I7:I59").Select
Selection.Copy
Range("F7").Select
ActiveSheet.Paste
Range("G7").Select
ActiveSheet.Paste
Range("H7").Select
ActiveSheet.Paste
Range("I7").Select
Sheets("FC 08 (LC)").Select
Range("g7:h60").Select
Selection.Locked = True
Selection.FormulaHidden = False
' Change the format of FC I column
Sheets("FC 08 (LC)").Select
Range("f22,f24:f26,f29:f30,f38,f42:f44").Select
Selection.Interior.ColorIndex = xlNone
Selection.Locked = True
Selection.FormulaHidden = False
' Gliederung for FC I ändern
Sheets("FC 08 (LC)").Select
Columns("g:i").Select
Selection.EntireColumn.Hidden = True
Sheets("FC 08 (LC)").Select
Columns("m").Select
Selection.EntireColumn.Hidden = True
Sheets("FC 08 (LC)").Select
Columns("c").Select
Selection.EntireColumn.Hidden = True
Sheets("FC 08 (LC)").Select
Columns("k").Select
Selection.EntireColumn.Hidden = True
Sheets("FC 08 (LC)").Select
Columns("d").Select
Selection.EntireColumn.Hidden = True
Range("M4") = "FC I - Ann. ACT"
Range("l4") = "FC I - BD"
'Range("k4") = "FC I - ACT 07"
Range("D4") = "Nov-07"
Range("E4") = "Nov-07"
Range("N9:N60").Select
Selection.ClearContents
Cells.Replace What:="ACT 06", Replacement:="ACT 07", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Sheets("FC 08 (EUR)").Select
Columns("g:i").Select
Selection.EntireColumn.Hidden = True
Sheets("FC 08 (EUR)").Select
Columns("m").Select
Selection.EntireColumn.Hidden = True
Sheets("FC 08 (EUR)").Select
Columns("c").Select
Selection.EntireColumn.Hidden = True
Sheets("FC 08 (EUR)").Select
Columns("k").Select
Selection.EntireColumn.Hidden = True
Sheets("FC 08 (EUR)").Select
Columns("d").Select
Selection.EntireColumn.Hidden = True
Range("M4") = "FC I - Ann. ACT"
Range("l4") = "FC I - BD"
'Range("k4") = "FC I - ACT 07"
Range("D4") = "Nov-07"
Range("E4") = "Nov-07"
Cells.Replace What:="ACT 06", Replacement:="ACT 07", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' Change FC I to BD in the Budget Overview
Sheets("BD 09-11 (LC)").Select
Range("D3") = "FC I"
Sheets("BD 09-11 (EUR)").Select
Range("D3") = "FC I"
' Adjustment FC I Investment Sheet
Sheets("Investment").Select
Columns("l:y").Select
Selection.EntireColumn.Hidden = False
Range("q5") = "FC I - BD"
Range("w5") = "FC I - BD"
Columns("r:w").Select
Selection.EntireColumn.Hidden = True
Columns("m:q").Select
Selection.EntireColumn.Hidden = True
Columns("p:q").Select
Selection.EntireColumn.Hidden = False
Range("o7:o300").Select
Selection.Copy
Range("l7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("l7:l200").Select
Selection.Interior.ColorIndex = xlNone
Selection.Locked = True
Selection.FormulaHidden = False
Range("l7:l300").Select
Selection.Copy
Range("m7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("m7:m300").Select
Selection.Copy
Range("n7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("n7:n300").Select
Selection.Copy
Range("o7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("o7:o200").Select
Selection.Interior.ColorIndex = xlNone
Range("L7:L200").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
'Application.CutCopyMode = False
'Selection.Copy
'Application.CutCopyMode = False
' Adjustment FC I SWDC Sheet Sheet
Sheets("SWDC Investment").Select
Range("o4") = "Investment 2008"
Range("p4") = "Investment 2009"
Range("q4") = "Investment 2010"
Range("r4") = "Investment 2011"
' Adjustment FC I Contracts Sheet
Sheets("Contracts").Select
Columns("k:af").Select
Selection.EntireColumn.Hidden = False
Range("o5") = "FC I - BD"
Range("x5") = "FC I - BD"
Range("K4:N4").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.UnMerge
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("k:n").Select
Selection.EntireColumn.Hidden = True
Columns("k:k").Select
Selection.EntireColumn.Hidden = False
Columns("t:ab").Select
Selection.EntireColumn.Hidden = True
Columns("ad:ae").Select
Selection.EntireColumn.Hidden = True
Range("K6") = "2008"
Range("L6") = "2008"
Range("M6") = "2008"
Range("N6") = "2008"
Range("n8:n201").Select
Selection.Copy
Range("K8:M8").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("n8:n201").Select
Selection.Interior.ColorIndex = xlNone
Range("L8:L201").Select
Selection.Locked = True
Selection.FormulaHidden = False
Range("K4") = "Cost 2008"
Range("Q4") = "Cost 2009"
Range("R4") = "Cost 2010"
Range("S4") = "Cost 2011"
Range("k8:k201").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
Range("K8:K201").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.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
' Adjustment FC I Book Values Sheet
Sheets("Book Values").Select
Range("A1") = "Book values for Investments before 31.12.2007"
Range("A4") = "Book value from Past Years Investments (31.12.2007)"
Range("A22") = "Book value from Past Years Investments (31.12.2008)"
Range("A40") = "Book value from Past Years Investments (31.12.2009)"
Range("A58") = "Book value from Past Years Investments (31.12.2010)"
Range("A77") = "Book value from Past Years Investments (31.12.2011)"
' Adjustment FC I Calculation_Depreciation Sheet
Sheets("Calculation_Depreciation").Select
Range("I6") = "2008"
Range("J6") = "2009"
Range("K6") = "2010"
Range("L6") = "2011"
Range("N6") = "2008"
Range("O6") = "2009"
Range("P6") = "2010"
Range("Q6") = "2011"
' Adjustment FC I Calculation_Depreciation_SWDC Sheet
Sheets("Berechnung_Depreciation_SWDC").Select
Range("J4") = "2008"
Range("K4") = "2009"
Range("L4") = "2010"
Range("M4") = "2011"
Range("O4") = "2008"
Range("P4") = "2009"
Range("Q4") = "2010"
Range("R4") = "2011"
' Adjustment FC I Calculation_Maintenance Sheet
Sheets("Calculation_Maintenance").Select
Range("C2") = "2008"
Range("D2") = "2009"
Range("E2") = "2010"
Range("F2") = "2011"
' Adjustment FC I Exc Rates Sheet
Sheets("Exc Rates").Select
Range("D9") = "December 2007"
Range("E9") = "December 2007"
Range("F9") = "2008"
Range("G9") = "2008"
Range("H9") = "2008"
Range("I9") = "2008"
Range("J9") = "2009"
Range("K9") = "2009"
Range("L9") = "2010"
Range("M9") = "2010"
Range("N9") = "2011"
Range("O9") = "2011"
' Anpassen der Jahre bei Sheet Depreciation New
Sheets("Depreciation new").Select
Range("A4") = "Depreciation from New Investments in 2008"
Range("A21") = "Depreciation from New Investments in 2009"
Range("A38") = "Depreciation from New Investments in 2010"
Range("A55") = "Depreciation from New Investments in 2011"
' Adjustments Hyperlink
Sheets("Project Report").Select
Range("H1").Select
Selection.Hyperlinks(1).TextToDisplay = "Sheet FC 08 (LC)"
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ColorIndex = 5
End With
Sheets("NSO Investment").Select
Range("E2").Select
Selection.Hyperlinks(1).TextToDisplay = "Sheet FC 08 (LC)"
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ColorIndex = 5
End With
Rows("13:13").Select
Selection.Insert Shift:=xlDown
Application.WindowState = xlMinimized
Range("A12") = "Investment Demand IT-5"
Range("A13") = "Investment Demand IT-3"
Rows("13:13").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(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Range("A12:DR12").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Sheets("Investment").Select
Range("G1").Select
Selection.Hyperlinks(1).TextToDisplay = "Sheet FC 08 (LC)"
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ColorIndex = 5
End With
Sheets("SWDC Investment").Select
Range("F1").Select
Selection.Hyperlinks(1).TextToDisplay = "Sheet FC 08 (LC)"
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ColorIndex = 5
End With
Sheets("Contracts").Select
Range("I1").Select
Selection.Hyperlinks(1).TextToDisplay = "Sheet FC 08 (LC)"
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ColorIndex = 5
End With
Sheets("Depreciation New").Select
Range("E1").Select
Selection.Hyperlinks(1).TextToDisplay = "Sheet FC 08 (LC)"
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ColorIndex = 5
End With
Sheets("Book Values").Select
Range("E1").Select
Selection.Hyperlinks(1).TextToDisplay = "Sheet FC 08 (LC)"
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ColorIndex = 5
End With
' Actual 2005 Copy and Paste
' ActiveWindow.ActivateNext
' Sheets("Actual 2005").Select
' Range("C3").Select
' While ActiveCell.Formula <> CountryName And ActiveCell.Formula <> "ENDE"
' ActiveCell.Offset(0, 1).Range("A1").Select
' Wend
' ActiveCell.Offset(4, 0).Range("A1:A70").Select
' Selection.Copy
' ActiveWindow.ActivateNext
' Sheets("MD").Select
' Range("C7").Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Budget 2006 Copy and Paste (from FC III)
' ActiveWindow.ActivateNext
' Sheets("Budget 2006").Select
' Range("F3").Select
' While ActiveCell.Formula <> CountryName And ActiveCell.Formula <> "ENDE"
' ActiveCell.Offset(0, 1).Range("A1").Select
' Wend
' ActiveCell.Offset(4, 0).Range("A1:A70").Select
' Selection.Copy
' ActiveWindow.ActivateNext
' Sheets("MD").Select
' Range("G7").Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' NSO previous year value copy and paste
' ActiveWindow.ActivateNext
' Sheets("NSO Euro").Select
' Range("E3").Select
' While ActiveCell.Formula <> CountryName And ActiveCell.Formula <> "ENDE"
' ActiveCell.Offset(0, 1).Range("A1").Select
' Wend
' ActiveCell.Offset(1, 0).Range("A1:A70").Select
' Selection.Copy
' ActiveWindow.ActivateNext
' Sheets("MD").Select
' Range("Q5").Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Cumulated 2007 Copy and Paste
ActiveWindow.ActivateNext
Sheets("Cumulated").Select
Range("C3").Select
While ActiveCell.Formula <> CountryName And ActiveCell.Formula <> "ENDE"
ActiveCell.Offset(0, 1).Range("A1").Select
Wend
ActiveCell.Offset(4, 0).Range("A1:A46").Select
Selection.Copy
ActiveWindow.ActivateNext
Sheets("Data").Select
Range("K7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Annualized 2007 Copy and Paste
ActiveWindow.ActivateNext
Sheets("Annualized").Select
Range("C3").Select
While ActiveCell.Formula <> CountryName And ActiveCell.Formula <> "ENDE"
ActiveCell.Offset(0, 1).Range("A1").Select
Wend
ActiveCell.Offset(4, 0).Range("A1:A46").Select
Selection.Copy
ActiveWindow.ActivateNext
Sheets("Data").Select
Range("L7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' New Exchange Rates
ActiveWindow.ActivateNext
Sheets("Exchange Rates").Select
Range("D10:O41").Select
Selection.Copy
ActiveWindow.ActivateNext
Sheets("Exc Rates").Select
Range("D10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' WACC Update
' ActiveWindow.ActivateNext
' Sheets("Exchange Rates").Select
' Range("C10:C41").Select
' Selection.Copy
' ActiveWindow.ActivateNext
' Sheets("Exc Rates").Select
' Range("C10").Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' All Worksheets protected and some very hidden
For Each wksWorksheet In ActiveWorkbook.Sheets
wksWorksheet.Protect Password:="Reporting", DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFiltering:=True
Next wksWorksheet
Sheets("Data").Visible = xlVeryHidden
Sheets("Lists").Visible = xlVeryHidden
Sheets("Exc rates").Visible = xlVeryHidden
Sheets("Berechnung_Depreciation_SWDC").Visible = xlVeryHidden
Sheets("Calculation_Depreciation").Visible = xlVeryHidden
Sheets("Calculation_Maintenance").Visible = xlVeryHidden
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("FC I 2008.xls").Activate
Sheets("Makros").Select
i = i + 1
[e9].Select
ActiveCell.Offset(i, 0).Select
Loop Until ActiveCell.Formula = "END"
End Sub
|