Скопируйте значения и формат границы тоже

Question

Я хочу скопировать некоторые данные из 2 столбцов (лист «Nastavit D», столбцы с Q2 по R1000) в конец столбцов с аналогичными данными на другом листе (лист «Цепной», столбец с A1 по B1000). У меня есть код для этого, но мне нужно улучшение, чтобы он также копировал форматы границ. Также, если ячейка С3 в листе называется «Недотыкать са !!!»TRUE, то я хочу, чтобы он копировал данные в Sheet с именем «Chain» ДО любых других данных (в основном, вставляя в него A1, «проталкивая» существующие данные вниз под новые скопированные данные), вместо того, чтобы положить их в конец,У меня есть код для копирования и помещения данных в конец таблицы «Цепочка».

Sub CopyRange()
    Dim x, y(), I As Long, ii As Long

    If Sheets("Nastavit D").[Q2] = "" Then Exit Sub
    x = Sheets("Nastavit D").[Q2:R1000]
    For I = 1 To UBound(x, 1)
        If x(I, 1) <> "" Then
            ReDim Preserve y(1 To 2, 1 To I)
            For ii = 1 To 2
                y(ii, I) = x(I, ii)
            Next
        Else: Exit For
        End If
    Next
    With Sheets("Chain")
        .Cells(.rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(y, 2), 2) = Application.Transpose(y)
    End With

End Sub

РЕДАКТИРОВАТЬ: Я начал переписывать весь код VBA на основе предложений @BigBenи @Джефф. Однако на данный момент он копирует весь диапазон Q2: R1000, даже пустые ячейки, потому что они содержат формулы, я думаю. Как я могу скопировать только ячейки с фактическими значениями, даже если они содержат формулы?

Sub CopyRangeUpdated()

Dim lastRow As Long

lastRow = Sheets("Chain").Range("A65536").End(xlUp).Row + 1

    If Sheets("Nastavit D").[Q2] = "" Then Exit Sub
    Sheets("Nastavit D").Range("Q2:R1000").Copy
  Sheets("Chain").Range("A" & lastRow).PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True
'clear clipboard
Application.CutCopyMode = False

End Sub

Answer 1

Вот пример кода для предложения @ BigBen

Отредактировано в ответ на редактирование вопроса

Пропуск пропусков не сжимает то, что копируется для удаления пробелов, он будетпросто "пропустить" их. например:

1 A

_ B

3 C

вставка col1 в col2 приведет к:

1

B

3

'copy range
Sheets("Nastavit D").Range("Q2:R1000").Copy

'paste values
Sheets("Chain").Range("A1").PasteSpecial xlPasteValuesAndNumberFormats

'clear clipboard
Application.CutCopyMode = False 

 'copy formatting
 Sheets("Nastavit D").Range("Q2:R1000").Copy 

'paste formatting
Sheets("Chain").Range("A1").PasteSpecial xlPasteFormats

Чтобы «протолкнуть данные», я бы заранее вставил ячейки:

Sheets("Chain").Rows("2:1001").insert Shift:=xlDown

Затем удалил пустые строки с чем-то вродеthis (i, чтобы предотвратить бесконечный цикл, если последняя строка пуста)

i=2
for x = 2 to 1001
    if i<10001 then
        if sheet("Chain").Range("A"&x).text = "" then
            Sheet("Chain").Range("A"&x).entirerow.delete xlshiftup

            'if say row2 is deleted, need to re-check row2 new value
            x = x-1
        end if
    else
        exit for
    end if
    i=i+1
next x