Sub RUN_412()
'
' RUN_412 Макрос
' Макрос записан 19.10.2011 (2000_sip)
'

'Ділення сум бюджетів на  100   000 , переведення в тис.грн.
    Workbooks.Open Filename:="C:\Program Files\SIP\F412\Budgetu.xls"
    Sheets("DerBud").Select
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "100000"
    Range("J1").Copy
    Range("G2:H3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "0.0"
    Sheets("MiscBud").Select
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "100000"
    Range("J1").Select
    Selection.Copy
    Range("G2:H3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "0.0"
    Sheets("OblBud").Select
    Range("J1").Select
    Selection.FormulaR1C1 = "100000"
    Selection.Copy
    Range("G2:H2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide, SkipBlanks _
        :=False, Transpose:=False
    Range("G2:H3").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=- 12 
    Application.CutCopyMode = False
    Selection.NumberFormat = "0.0"
    
    Sheets("Zagalna").Select
    Range("I7:J53").Copy
    Windows("F412.xls").Activate
    Sheets("Держ.бюд.").Select
    Range("I7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Місц.Бюдж.").Select
    Windows("Budgetu.xls").Activate
    Range("I57:J134").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("F412.xls").Activate
    Range("I4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("412").Select
    Range("B2").Select
    Application.CutCopyMode = False
    
    
     Windows("Budgetu.xls").Activate
    Range("I142:J229").Select
    Selection.Copy
    Windows("F412.xls").Activate
    Sheets("Міськ.Бюдж.").Select
    Range("I8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
     
    ActiveWorkbook.Save
    Windows("Budgetu.xls").Activate
    ActiveWorkbook.Save
     ActiveWindow.Close
     Windows("F412.xls").Activate
    Sheets("412").Select
    Range("C4:C65").Select
End Sub

 Private Sub Perenos()

'Перенос даних з 3-х файлів (Держ.бюд., Місц.бюд., Обл.Бюд.) папки I:\IN\BANK\F412\ до
'відповідних вкладок в Budjetu.xls

 
    Sheets("DerBud").Select
    Columns("B:H").Select
    Selection.ClearContents
    Sheets("MiscBud").Select
    Columns("B:H").Select
    Selection.ClearContents
    Sheets("OblBud").Select
    Columns("B:H").Select
    Selection.ClearContents
    Sheets("Zagalna").Select
    Range("I7").Select





iDate = Application.InputBox("Число", , "15")
iMounth = Application.InputBox("Місяць", , "11")
If iDate = "10" Then iDate = "A"      '
If iDate = "11" Then iDate = "B"      '
If iDate = "12" Then iDate = "C"      '
If iDate = "13" Then iDate = "D"      '
If iDate = "14" Then iDate = "E"      '      '
If iDate = "15" Then iDate = "F"      '      '
If iDate = "16" Then iDate = "G"      '      '
If iDate = "17" Then iDate = "H"      '      '
If iDate = "18" Then iDate = "I"      '
If iDate = "19" Then iDate = "J"      '
If iDate = "20" Then iDate = "K"      '      '      'Прописування дат
If iDate = "21" Then iDate = "L"      '
If iDate = "22" Then iDate = "M"      '
If iDate = "23" Then iDate = "N"      '      '
If iDate = "24" Then iDate = "O"      '      '
If iDate = "25" Then iDate = "P"      '      '
If iDate = "26" Then iDate = "Q"      '      '
If iDate = "27" Then iDate = "R"      '
If iDate = "28" Then iDate = "S"      '
If iDate = "29" Then iDate = "T"      '
If iDate = "30" Then iDate = "U"      '
If iDate = "31" Then iDate = "V"      '

If iMounth = "10" Then iMounth = "A"      '
If iMounth = "11" Then iMounth = "B"      '      'Прописування місяців
If iMounth = "12" Then iMounth = "C"      '



iDerBud = "FT010" & iMounth & iDate & "0.002"   'Файл Державного бюджету
iMiscBud = "FT110" & iMounth & iDate & "0.002"  'Файл Місцевого бюджету
iOblBud = "FT110" & iMounth & iDate & "0.001"   'Файл Обласного бюджету

iFullNameDB = "I:\IN\BANK\F412\" & iDerBud      'Повне ім"я Державного бюджету для перевірки наявності файлів


If iDerBud = Dir(iFullNameDB) Then

ChDir "I:\IN\BANK\F412"
    Workbooks.Open Filename:="I:\IN\BANK\F412\" & iDerBud ' Відкриття файлу з Державним бюджетом
    
    Columns("A:G").Copy                 '
    Windows("Budgetu.xls").Activate     '
    Sheets("DerBud").Select             '
    Columns("B:H").Select               '  'Копіювання даних бюджету у форму Ексель
    ActiveSheet.Paste                   '
    Windows(iDerBud).Activate           '
    ActiveWindow.Close                  '



ChDir "I:\IN\BANK\F412"
    Workbooks.Open Filename:="I:\IN\BANK\F412\" & iMiscBud ' Відкриття файлу з Місцевим бюджетом
    
    Columns("A:G").Copy                 '
    Windows("Budgetu.xls").Activate     '
    Sheets("MiscBud").Select             '
    Columns("B:H").Select               '  'Копіювання даних бюджету у форму Ексель
    ActiveSheet.Paste                   '
    Windows(iMiscBud).Activate           '
    ActiveWindow.Close                  '
ChDir "I:\IN\BANK\F412"

    Workbooks.Open Filename:="I:\IN\BANK\F412\" & iOblBud ' Відкриття файлу з Обласним бюджетом

    Columns("A:G").Copy                 '
    Windows("Budgetu.xls").Activate     '
    Sheets("OblBud").Select             '
    Columns("B:H").Select               '  'Копіювання даних бюджету у форму Ексель
    ActiveSheet.Paste                   '
    Windows(iOblBud).Activate           '
    ActiveWindow.Close
   Else
    MsgBox ("Файли із вказаною датою відсутні")
   
   
End If
Windows("Budgetu.xls").Activate
ActiveWorkbook.Save
End Sub