Перенос баланса

Public RowC As Integer
'
'Sub ПереносБаланса()
'   Dim shdto As New Worksheet
'   Dim shdfrom As New Worksheet
'   Set shdto = Worksheets("Тест")
'   Set shdfrom = Worksheets("Баланс")
'   Dim RowC As Integer
''   Worksheets("Тест").Range("A:G").ClearContents
''   Selection.Delete Shift:=xlUp
'
'    Sheets("Тест").Select
'    Cells.Select
'    Selection.Delete Shift:=xlUp
''Первый этап-------------------------------------
''   RowC = 1
''   For Row = 1 To 20
''   GrayOrColor shdfrom, shdto, Row, RowC
''       If shdfrom.Range("B" & Row).Value > 0 And _
''          IsNumeric(shdfrom.Range("B" & Row).Value) Then
''            shdto.Range("A" & RowC) = shdfrom.Range("A" & Row).Value
''            shdto.Range("B" & RowC) = shdfrom.Range("B" & Row).Value
''            RowC = RowC + 1
''       End If
''   Next Row
'
'
'   RowC = 1
'   For Row = 1 To 20
'   GrayOrColor shdfrom, shdto, Row, RowC, "E", "G"
'        If shdfrom.Range("F" & Row).Value <> 0 And _
'          IsNumeric(shdfrom.Range("F" & Row).Value) Then
'            shdto.Range("E" & RowC) = shdfrom.Range("E" & Row).Value
'            shdto.Range("F" & RowC) = shdfrom.Range("F" & Row).Value
'            RowC = RowC + 1
'       End If
'   Next Row
'
''Второй этап-------------------------------------
'   RowC = 21
'   For Row = RowC To 200
'   GrayOrColor shdfrom, shdto, Row, RowC
'       If shdfrom.Range("C" & Row).Value > 0 And _
'          IsNumeric(shdfrom.Range("C" & Row).Value) Then
'            shdto.Range("A" & RowC) = shdfrom.Range("A" & Row).Value
'            shdto.Range("C" & RowC) = shdfrom.Range("C" & Row).Value
'            RowC = RowC + 1
'       End If
'   Next Row
'
'
'   RowC = 21
'   For Row = RowC To 200
'   GrayOrColor shdfrom, shdto, Row, RowC, "E", "G"
'        If shdfrom.Range("G" & Row).Value > 0 And _
'          IsNumeric(shdfrom.Range("G" & Row).Value) Then
'            shdto.Range("E" & RowC) = shdfrom.Range("E" & Row).Value
'            shdto.Range("G" & RowC) = shdfrom.Range("G" & Row).Value
'            RowC = RowC + 1
'       End If
'   Next Row
'
'
''Форматирование
'shdto.Columns("A:A").ColumnWidth = 45
'shdto.Columns("E:E").ColumnWidth = 45
'shdto.Columns("B:C").ColumnWidth = 15
'shdto.Columns("F:G").ColumnWidth = 15
'shdto.Columns("B:C").NumberFormat = "#,##0_ ;[Red]-#,##0 "
'shdto.Columns("F:G").NumberFormat = "#,##0_ ;[Red]-#,##0 "
'
'RowA = Split(shdto.Range("A:A").Find("ИТОГО:").Address, "$")(2)
'RowE = Split(shdto.Range("E:E").Find("ИТОГО:").Address, "$")(2)
'shdto.Range("E" & RowA) = shdto.Range("E" & RowE)
'shdto.Range("F" & RowA) = shdto.Range("F" & RowE)
'shdto.Range("E" & RowE & ":" & "F" & RowE).Clear
'
'shdto.Range("A" & RowA & ":" & "G" & RowA).Select
'    Selection.Font.Bold = True
'
'For Row = 2 To RowA
'    shdto.Range("C" & Row).FormulaLocal = "=B" & Row & "/" & "$B$" & RowA
'    shdto.Range("G" & Row).FormulaLocal = "=F" & Row & "/" & "$F$" & RowA
'    shdto.Range("C" & Row).NumberFormat = "0%"
'    shdto.Range("G" & Row).NumberFormat = "0%"
'Next Row
'End Sub
 
 
 
'MyArr
Sub fff()
Dim MyArr
MyArr = Array(10, 22, 100, "ghghgh")
 
For Each A In MyArr
  Debug.Print A
Next
End Sub
 
'Серое
Sub GrayOrColor(ByVal shdfrom As Worksheet, _
                ByVal shdto As Worksheet, _
                ByVal Row As Integer, _
                ByRef RowC As Integer, _
                Optional Col1 As String = "B", _
                Optional Col2 As String = "U", _
                Optional Col3 As String = "V", _
                Optional Col4 As String = "Y", _
                Optional xtxFROM As String = "A", _
                Optional Col5 As String = "V", _
                Optional Col6 As String = "Y", _
                Optional txtRCorG As String = "C")
 
    If shdfrom.Range(xtxFROM & Row).Interior.ColorIndex > 0 And shdfrom.Range(txtRCorG & Row + 1).Value > 0 Then
          shdto.Range(Col1 & RowC & ":" & Col4 & RowC).Merge
          shdto.Range(Col1 & RowC & ":" & Col4 & RowC).Select
          Selection.Font.Bold = True
          Selection.HorizontalAlignment = xlCenter
          Selection.VerticalAlignment = xlBottom
          Selection.Interior.ColorIndex = shdfrom.Range(xtxFROM & Row).Interior.ColorIndex
          shdto.Range(Col1 & RowC) = shdfrom.Range(xtxFROM & Row).Value
          RowC = RowC + 1
    Else
'          Application.DisplayAlerts = False
          shdto.Range(Col1 & RowC & ":" & Col2 & RowC).Merge
          shdto.Range(Col3 & RowC & ":" & Col4 & RowC).Merge
          shdto.Range(Col5 & RowC & ":" & Col6 & RowC).Merge
 
          shdto.Range(Col3 & RowC & ":" & Col4 & RowC).NumberFormat = "#,##0_ ;[Red]-#,##0 "
          shdto.Range(Col5 & RowC & ":" & Col6 & RowC).NumberFormat = "#,##0_ ;[Red]-#,##0 "
'          shdto.Range(Col1 & RowC & ":" & Col2 & RowC).Merge
'          shdto.Range(Col3 & RowC & ":" & Col4 & RowC).Merge
 
'          Application.DisplayAlerts = True
      End If
 
 
End Sub
 
 
 
Sub ПереносБаланса2()
   Application.DisplayAlerts = False
   Dim shdto As New Worksheet
   Dim shdfrom As New Worksheet
   Set shdto = Worksheets("Заключение")
   Set shdfrom = Worksheets("СводБаланс")
   Dim RowC As Integer
'   Worksheets("Тест").Range("A:G").ClearContents
'   Selection.Delete Shift:=xlUp
 
'    Sheets("Тест").Select
'    Cells.Select
'    Selection.Delete Shift:=xlUp
'Первый этап-------------------------------------
 
   shdto.Select
   shdto.Range("RangeBS1").Clear
   shdto.Range("RangeBS1").RowHeight = 12
   RowC = shdto.Range("RangeBS1").Row
   shdto.Range("RangeBS1").Select
   Selection.Font.Bold = False
   Selection.Clear
   Selection.UnMerge
   With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
 
RowC = shdto.Range("RangeBS1").Row
 
   For Row = 3 To 20
   GrayOrColor shdfrom, shdto, Row, RowC, "B", "P", "Q", "U"
       If shdfrom.Range("B" & Row).Value > 0 And _
          IsNumeric(shdfrom.Range("C" & Row).Value) Then
            shdto.Range("B" & RowC) = shdfrom.Range("A" & Row).Value
            shdto.Range("Q" & RowC) = shdfrom.Range("B" & Row).Value
            RowC = RowC + 1
       End If
   Next Row
'
RowC = shdto.Range("RangeBS1").Row
 
   For Row = 3 To 20
   GrayOrColor shdfrom, shdto, Row, RowC, "AB", "AP", "AQ", "AU", "E", "AV", "AY"
        If shdfrom.Range("F" & Row).Value <> 0 And _
          IsNumeric(shdfrom.Range("F" & Row).Value) Then
            shdto.Range("AB" & RowC) = shdfrom.Range("E" & Row).Value
            shdto.Range("AQ" & RowC) = shdfrom.Range("F" & Row).Value
            RowC = RowC + 1
       End If
   Next Row
 
''Второй этап-------------------------------------
   shdto.Range("RangeBS2").Clear
   shdto.Range("RangeBS2").RowHeight = 12
   RowC = shdto.Range("RangeBS2").Row
   shdto.Range("RangeBS2").Select
   Selection.Font.Bold = False
   Selection.UnMerge
   With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
 
RowC = shdto.Range("RangeBS2").Row
   For Row = 20 To 200
   Application.ScreenUpdating = False
   GrayOrColor shdfrom, shdto, Row, RowC
       If shdfrom.Range("C" & Row).Value > 0 And _
          IsNumeric(shdfrom.Range("C" & Row).Value) Then
            shdto.Range("B" & RowC) = shdfrom.Range("A" & Row).Value
            shdto.Range("V" & RowC) = shdfrom.Range("C" & Row).Value
            RowC = RowC + 1
       End If
   Next Row
   Application.ScreenUpdating = True
 
 
RowC = shdto.Range("RangeBS2").Row
   For Row = 20 To 200
   GrayOrColor shdfrom, shdto, Row, RowC, "AB", "AU", "AV", "AY", "E", , , "G"
        If shdfrom.Range("G" & Row).Value > 0 And _
          IsNumeric(shdfrom.Range("G" & Row).Value) Then
            shdto.Range("AB" & RowC) = shdfrom.Range("E" & Row).Value
            shdto.Range("AV" & RowC) = shdfrom.Range("G" & Row).Value
            RowC = RowC + 1
       End If
   Next Row
Application.DisplayAlerts = True
 
 
'Форматирование
'shdto.Columns("A:A").ColumnWidth = 45
'shdto.Columns("E:E").ColumnWidth = 45
'shdto.Columns("B:C").ColumnWidth = 15
'shdto.Columns("F:G").ColumnWidth = 15
shdto.Columns("QU:QU").NumberFormat = "#,##0_ ;[Red]-#,##0 "
shdto.Columns("AQ:AQ").NumberFormat = "#,##0_ ;[Red]-#,##0 "
 
Row1 = Extract_Number_from_Text(Split(shdto.Range("RangeBS1").Address, "$")(1))
 
RowA = Split(shdto.Range("B" & Row1 & ":P" & Row1 + 21).Find("ИТОГО:").Address, "$")(2)
RowE = Split(shdto.Range("AB" & Row1 & ":AP" & Row1 + 21).Find("ИТОГО:").Address, "$")(2)
 
If RowA <> RowE Then
    shdto.Range("AB" & RowA) = shdto.Range("AB" & RowE)
    shdto.Range("AQ" & RowA) = shdto.Range("AQ" & RowE)
    shdto.Range("AB" & RowE & ":" & "AU" & RowE).Clear
End If
 
shdto.Range("B" & RowA & ":" & "U" & RowA).Select
    Selection.Font.Bold = True
 
For Row = Row1 To RowA
    shdto.Range("V" & Row).FormulaLocal = "=Q" & Row & "/" & "$Q$" & RowA
    shdto.Range("AV" & Row).FormulaLocal = "=AQ" & Row & "/" & "$AQ$" & RowA
    shdto.Range("V" & Row).NumberFormat = "0%"
    shdto.Range("AV" & Row).NumberFormat = "0%"
Next Row
 
'RowA = Split(shdto.Range("B21:U200").Find("ИТОГО:").Address, "$")(2)
'RowE = Split(shdto.Range("AB21:AU200").Find("ИТОГО:").Address, "$")(2)
Row2 = Extract_Number_from_Text(Split(shdto.Range("RangeBS2").Address, "$")(2))
 
RowA = Split(shdto.Range("A" & Row2 & ":U" & Row2 + 300).Find("ИТОГО:").Address, "$")(2)
RowE = Split(shdto.Range("AB" & Row2 & ":AU" & Row2 + 300).Find("ИТОГО:").Address, "$")(2)
 
shdto.Range("AB" & RowA) = shdto.Range("AB" & RowE)
shdto.Range("AV" & RowA) = shdto.Range("AV" & RowE)
shdto.Range("AB" & RowE & ":" & "AY" & RowE).Clear
shdto.Range("AV" & RowA).NumberFormat = "#,##0_ ;[Red]-#,##0 "
 
 
Application.ScreenUpdating = False
For i = RowE To RowA
shdto.Range("AB" & i & ":AU" & i).Merge
shdto.Range("AV" & i & ":AY" & i).Merge
Next i
 
 
RowA1 = Split(shdto.Range("B:P").Find("Всего текущих активо").Address, "$")(2)
RowA2 = Split(shdto.Range("AB:AP").Find("Всего текущей зад-ти").Address, "$")(2)
RowA3 = Split(shdto.Range("AB:AP").Find("Собственный капитал").Address, "$")(2)
 
shdto.Range("Q" & RowA1).Name = "ВсегоАктивов"
shdto.Range("AQ" & RowA2).Name = "ВсегоПассивов"
shdto.Range("AQ" & RowA3).Name = "СобственныйКапитал"
 
 
shdto.Range("B" & RowA1 & ":Y" & RowA1).Font.Bold = True
shdto.Range("AB" & RowA2 & ":AY" & RowA2).Font.Bold = True
shdto.Range("AB" & RowA3 & ":AY" & RowA3).Font.Bold = True
shdto.Range("A" & RowA & ":AY" & RowA).Font.Bold = True
 
'окончательное форматирование
r1 = Extract_Number_from_Text(Split(shdto.Range("RangeBS1").Address, "$")(1))
r2 = Extract_Number_from_Text(Split(shdto.Range("RangeBS1").Find("ИТОГО:").Address, "$")(2))
   shdto.Range("B" & r1 & ":Y" & r2).Select
   ФорматированиеБаланса
   shdto.Range("AB" & r1 & ":AY" & r2).Select
   ФорматированиеБаланса
shdto.Range("AB" & r2 & ":AY" & r2).Font.Bold = True
 
r1 = Extract_Number_from_Text(Split(shdto.Range("RangeBS2").Address, "$")(2))
r2 = Extract_Number_from_Text(Split(shdto.Range("RangeBS2").Find("ИТОГО:").Address, "$")(2))
   shdto.Range("B" & r1 & ":Y" & r2).Select
   ФорматированиеБаланса
   shdto.Range("AB" & r1 & ":AY" & r2).Select
   ФорматированиеБаланса
 
rStart = r2
rEnd = Split(shdto.Range("RangeBS2").Address, "$")(4)
shdto.Rows(rStart & ":" & rEnd).Hidden = True
 
Application.ScreenUpdating = True
End Sub
 
 
Sub ФорматированиеБаланса()
 
 
   Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.349986266670736
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.349986266670736
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.349986266670736
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.349986266670736
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.349986266670736
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.349986266670736
        .Weight = xlThin
    End With
End Sub
Sub GrayOrColor2(ByVal shdfrom As Worksheet, ByVal shdto As Worksheet, ByVal Row As Integer, ByRef RowC As Integer, _
                          Optional Col1 As String = "B", Optional Col2 As String = "Y")
    If shdfrom.Range(Col1 & Row).Interior.ColorIndex > 0 Then
          shdto.Range(Col1 & RowC & ":" & Col2 & RowC).Merge
          shdto.Range(Col1 & RowC & ":" & Col2 & RowC).Select
          Selection.Font.Bold = True
          Selection.HorizontalAlignment = xlCenter
          Selection.VerticalAlignment = xlBottom
          Selection.Interior.ColorIndex = shdfrom.Range(Col1 & Row).Interior.ColorIndex
          shdto.Range(Col1 & RowC) = shdfrom.Range(Col1 & Row).Value
          RowC = RowC + 1
      End If
End Sub
 
 
Sub ResetSelect1()
Set shdto = Worksheets("Заключение")
 
RowA1 = Split(shdto.Range("RangeBS1").Find("Всего текущих активо").Address, "$")(2)
RowA2 = Split(shdto.Range("RangeBS1").Find("Всего текущей зад-ти").Address, "$")(2)
RowA3 = Split(shdto.Range("RangeBS1").Find("Собственный капитал").Address, "$")(2)
 
shdto.Range("Q" & RowA1).Name = "ВсегоАктивов"
shdto.Range("AQ" & RowA2).Name = "ВсегоПассивов"
shdto.Range("AQ" & RowA3).Name = "СобственныйКапитал"
 
 
shdto.Range("B" & RowA1 & ":Y" & RowA1).Font.Bold = True
shdto.Range("AB" & RowA2 & ":AY" & RowA2).Font.Bold = True
shdto.Range("AB" & RowA3 & ":AY" & RowA3).Font.Bold = True
End Sub