Как вставить значения ячеек перед существующими значениями ячеек в VBA

Question

У меня есть код в VBA, который копирует 2 столбца существующих значений под аналогичными данными другого листа. Я хочу немного изменить код VBA, чтобы, если ячейка значения другого листа (C3) была TRUE, то вместо этого она копировала эти данные в начало существующих данных (начало A1 и B1). У меня есть эти данные на листе:

-Q-  -R-
156  F5
486  T9
695  H3

У меня уже есть данные на другом листе:

-A-  -B-
695  E6
326  T8
326  Q9

Мне нужно вставить новые значения перед существующими значениями, еслизначение C3 на другом листе равно TRUE

-A-  -B-
156  F5
486  T9
695  H3
695  E6
326  T8
326  Q9

У меня есть код для копирования данных в конец существующих данных, мне просто нужно расширить его, чтобы иметь возможность вставить данные в началоданные, существенно сдвигая все существующие значения ниже новых, если C3 равен TRUE. (Значения, которые мне нужно скопировать, находятся на листе «Nastavit D» (Q и R), мне нужно вставить их в «Цепочку (A и B)», а ячейка C3 TRUE находится на «Nedotykat sa !!! "лист) (Если C3 - ЛОЖЬ, мне нужно скопировать его в конец существующих данных, что мой код уже делает, без проверки C3.)

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

Answer 1

Не полностью протестировано, но я думаю, вы поняли.

If Worksheets("Nedotykat sa!!!").Range("C3") Then

    With Sheets("Chain")

        Dim originalData as Variant
        originalData = .Range(.Range("A2"),.Range("B2").End(xlDown)) 'grab original data

        .cells(2,1).Resize(Ubound(y,2),2) = Application.Transpose(y) 'write new data
        .cells(.rows.count,1).End(xlUp).Offset(1).Resize(ubound(originalData,2),ubound(originalData,1)) = originalData 'write original data at the bottom

    End With

Else

    With Sheets("Chain")
        .Cells(.rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(y, 2), 2) = Application.Transpose(y)
    End With

End If

Answer 2

Вы можете сделать это двумя тремя способами. Во-первых, вы можете копировать и вставлять, используя встроенные методы Excels.
Это так просто, как показано ниже:

Edit1: Я настроил поиск последней строки. Это найдет последнюю ячейку в столбце Q со значением, если ячейка не была найдена, последняя строка - lr будет установлена ​​в 1000.

Dim lr As Long
With Sheets("Nastavit D")
  '// simply find the last row, can be done in various ways //
  'lr = .Range("Q" & .Rows.Count).End(xlUp).Row

   On Error Resume Next
   lr = .Range("Q:Q").Find(What:="*", LookIn:=xlValues, _
                           SearchDirection:=xlPrevious).Row
   If Err.Number <> 0 Then lr = 1000
   On Error GoTo 0

  .Range("Q2:R" & lr).Copy '// copy the data //
End With
'// insert data in target range //
Sheets("Chain").Range("A2").Insert xlDown

Другая использует массив, но я все еще использую метод вставкиExcel, как показано ниже (гибрид).

Dim lr As Long, v
With Sheets("Nastavit D")
  '// same as above, get the last row
  lr = .Range("Q" & .Rows.Count).End(xlUp).Row
  v = .Range("Q2:R" & lr) '// pass to array //
End With

With Sheets("Chain")
  '// insert a range the size of the array //
  .Range("A2").Resize(UBound(v, 1), UBound(v, 2)).Insert xlDown, xlFormatFromLeftOrAbove
  '// dump array in the space created //
  .Range("A2").Resize(UBound(v, 1), UBound(v, 2)) = v
End With

Если нет необходимости создавать массив, я бы посоветовал вам сделать первый.
Последний подход уже предоставлен, вы выгружаете обе данные в массив как * отправил 1018 *.