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

[VanBlack]

Данный макрос копирует содержимое диапазона ячеек (B43:D66) с листов в имени которых содержатся скобки на лист "Ход поединков 1-8 финалов". Проблема в том, что в ячейках содержатся формулы. Как исправить, чтобы копировались значения ячеек?

Код: Выделить всё

Sub Добавить_в_Ход_поединков_Восьмые_финалов()
    Dim Sh As Worksheet, i As Long
    i = 3
    For Each Sh In ThisWorkbook.Sheets
        If InStr(3, Sh.Name, "(") > 0 Then
            Sh.[B43:D66].Copy Sheets("Ход поединков 1-8 финалов").Cells(i, 2)
            i = i + 24
        End If
    Next Sh
End Sub

[somewhere]

Использовать функции Copy с пустым параметром и PasteSpecial

[VanBlack]

Использовать функции Copy с пустым параметром и PasteSpecial

Если не трудно, поправьте в макросе. Я не знаю как это делается (прописывается).

[SAS888]

Строку

Код: Выделить всё

Sh.[B43 :D 66].Copy Sheets("Ход поединков 1-8 финалов").Cells(i, 2)

замените на

Код: Выделить всё

Sheets("Ход поединков 1-8 финалов").Cells(i, 2).Resize(24, 3).Value = Sh.[B43 :D 66].Value

[VanBlack]

Спасибо огромное! Всё отлично встало на свои места! Какой раз вы уж меня выручаете! Ещё раз Спасибо!

[VanBlack]

Ещё огромная просьба, как прописать, если указанные диапазоны на листе пустые, то их не копировать?

[SAS888]

Например, так:

Код: Выделить всё

Sub Добавить_в_Ход_поединков_Восьмые_финалов()
    Dim Sh As Worksheet, i As Long, x As Range
    i = 3
    For Each Sh In ThisWorkbook.Sheets
        If InStr(3, Sh.Name, "(") > 0 Then
            Set x = Sh.[B43 :D 66]
            If Application.CountA(x) <> 0 Then
                Sheets("Ход поединков 1-8 финалов").Cells(i, 2).Resize(24, 3).Value = x.Value
                i = i + 24
            End If
        End If
    Next Sh
End Sub

[VanBlack]

Пустые диапазоны не пропускает, также копирует, с указанием во всех пустых ячейках что нет данных... (#Н/Д)
P.S. Дико извиняюсь, это я допустил ошибку в написании. Всё скопировал правильно. Только в конце добавил один пустой диапазон с такими же #Н/Д. Не так критично, но если это можно исправить, было бы вообще здорово!
Поправка... Для диапазона [B43:D66] всё прошло нормально и в конце не добавлял пустой диапазон с #Н/Д, но при его изменении для четвертьфиналов [B67:D78] в конце добавился пустой диапазон с #Н/Д... Код изменил так:

Код: Выделить всё

Sub Добавить_в_Ход_поединков_Четвертьфиналы()
    Dim Sh As Worksheet, i As Long, x As Range
    i = 3
    For Each Sh In ThisWorkbook.Sheets
        If InStr(3, Sh.Name, "(") > 0 Then
            Set x = Sh.[B67:D78]
            If Application.CountA(x) <> 0 Then
                Sheets("Ход поединков Четвертьфиналы").Cells(i, 2).Resize(24, 3).Value = x.Value
                i = i + 12
            End If
        End If
    Next Sh
End Sub

Копируемые диапазоны выглядят так: (см. вложение)

[VanBlack]

Блин, вот лопух, недоглядел... в Resize(24, 3) надо было тоже выставить 12... Всё отлично работает! Премного благодарен, - низкий поклон!

[VanBlack]

Как поправить данный код, чтобы если значения ячеек диапазона пустые, то диапазон не копировать. Сейчас, если хоть одна ячейка диапазона содержит формулу, несмотря, что все значения ячеек диапазона пустые, копирование производится. Если я удаляю формулы, то не производится.

Код: Выделить всё

Sub Добавить_в_Ход_поединков_Четвертьфиналы()
    Dim Sh As Worksheet, i As Long, x As Range
    i = 3
    For Each Sh In ThisWorkbook.Sheets
        If InStr(3, Sh.Name, "(") > 0 Then
            Set x = Sh.[B67 :D 78]
            If Application.CountA(x) <> 0 Then
                Sheets("Ход поединков Четвертьфиналы").Cells(i, 2).Resize(24, 3).Value = x.Value
                i = i + 12
            End If
        End If
    Next Sh
End Sub