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

```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```