Копирование значений ячеек

Sub Добавить_в_Ход_поединков_Восьмые_финалов()
    Dim Sh As Worksheet, i As Long, marr(), cC As Range, j&
    i = 3
    For Each Sh In ThisWorkbook.Sheets
        If InStr(3, Sh.Name, "(") > 0 Then
            ReDim marr(1 To [B43:D66].Cells.Count, 1 To 1): j = 0
            Err.Number = 0: On Error Resume Next
               For Each cC In [B43:D66].SpecialCells(xlCellTypeConstants, 3)
                  j = j + 1: marr(j, 1) = cC.Value
               Next
            If Err.Number <> 0 Then MsgBox "NO VALUE IN CELLS"
               With Sheets("Ход поединков 1-8 финалов").Cells(i, 2)
                  .Resize(UBound(marr, 1), UBound(marr, 2)).Value = marr
               End With
        End If
    Next Sh
End Sub

Sub Добавить_в_Ход_поединков_Восьмые_финалов()
    Dim Sh As Worksheet, i As Long, marr(), cC As Range, j&
    i = 3
    For Each Sh In ThisWorkbook.Sheets
        If InStr(3, Sh.Name, "(") > 0 Then
            ReDim marr(1 To [b43:d66].Cells.Count, 1 To 1): j = 0
            Err.Number = 0: On Error Resume Next
               For Each cC In [b43:d66].SpecialCells(xlCellTypeConstants, 3)
                  j = j + 1: marr(j, 1) = cC.Value
               Next
            If Err.Number <> 0 Then
               MsgBox "NO VALUE IN CELLS"
                  Else
                     Sh.Activate:  Sh.[b43:d66].SpecialCells(xlCellTypeConstants, 3).Select
            End If
Stop
               With Sheets("Ход поединков 1-8 финалов").Cells(i, 2)
                  .Resize(UBound(marr, 1), UBound(marr, 2)).Value = marr
               End With
        End If
    Next Sh
End Sub

Sub Добавить_в_Ход_поединков_Восьмые_финалов()
    Dim Sh As Worksheet, i As Long, marr(), j&
    i = 3
    For Each Sh In ThisWorkbook.Sheets
        If InStr(3, Sh.Name, "(") > 0 Then
            ReDim marr(1 To [b43:d66].Cells.Count, 1 To 2): j = 0
               With Sh.[b43:d66]
                  For i = LBound(marr, 1) To UBound(marr, 1)
                     If Application.CountA.Rows(j) > 0 Then
                        j = j + 1: marr(j, 1) = .Rows(j).Item(1).Value: marr(j, 2) = .Rows(j).Item(2).Value
                     End If
                  Next 'i
               End With
               With Sheets("Ход поединков 1-8 финалов").Cells(i, 2)
                  .Resize(UBound(marr, 1), UBound(marr, 2)).Value = marr:  i = i + 24
               End With
        End If
    Next Sh
End Sub

Sub v2_Add_в_Ход_поединков_Восьмые_финалов()
Dim Sh As Worksheet, i As Long, marr(), j&, cC As Range, a&, r&, f&
   For Each Sh In ThisWorkbook.Sheets
      Err.Number = 0: On Error Resume Next
         i = Sh.[B43:D66].SpecialCells(xlCellTypeConstants, 3).Cells.Count
            If Err.Number = 0 Then
               ReDim marr(1 To [B43:D66].Rows.Count, 1 To 3): j = 0
                  With Sh.[B43:D66]
                     For i = LBound(marr, 1) To UBound(marr, 1)
                     If Application.CountA(.Rows(i)) > 0 Then
                        j = j + 1
                        For f = LBound(marr, 2) To UBound(marr, 2): marr(j, f) = .Rows(i).Cells(f).Value: Next 'j
                     End If
                     Next 'i
                  End With
                  With Sheets("Ход поединков 1-8 финалов").Cells(1, 2)
                     .Resize(UBound(marr, 1), UBound(marr, 2)).Value = marr:  i = i + 24
                  End With
               End If
         On Error GoTo 0
   Next 'each
End Sub