VBA - копирование диапазона на новый лист, смещение этого диапазона в другое место и повторное копирование

Question

У меня небольшая проблема. Я пытаюсь написать код, который выберет диапазон данных, например, A2: [до последней строки], например, F36 с одного листа и скопировать его, например. ячейка (1,1) на другом листе. Затем сместите этот диапазон на n-е число вправо (чтобы диапазон не расширялся и не изменял значение, а только перемещался на n-й столбец вправо), затем скопируйте этот диапазон и снова вставьте его на другой лист. Более того, я хочу, чтобы мои данные вставлялись после последней строки ранее вставленных данных.

Набор данных не определяется жесткими числами, поэтому действия по копированию и вставке чисел не являются фиксированными. Было бы здорово, если бы они выполнялись с помощью некоторых шагов, например до последнего пустого столбца.

Кто-нибудь есть идеи, чтобы решить эту проблему?

Sub copy()
Dim lastRow As Long
Dim lastCol As Long
' this finds the number of the last row
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
' beginig of the script


  '1st range
    Dim i As Integer, MyRange As Range
For i = 1 To 2
    Sheets("Sheet1").Activate
   ' Range("B8:F27").Select
    Set MyRange = Range("B8:H27").Offset(0, i * 7)
    MyRange.Select
    Selection.copy
    Sheets("Sheet2").Activate
    Cells(lastRow + 1, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
   :=False, Transpose:=False
    Cells(lastRow + 1, 1).PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks _
   :=False, Transpose:=False
     Application.CutCopyMode = False


Next i


End Sub

Вот что я пробовал. Смещение работает правильно. У меня проблемы с копированием. Диапазон перемещается нормально, но он копирует только 3-ий последний шаг в Sheet2. Я верю, что должен использовать 2-й цикл, но не знаю, как правильно сформулировать его в этом случае.

Edit2: сделали это.

    Sub CopyRanges()
    Dim lastRow As Long
    Dim lastCol As Long
    Dim i As Integer, MyRange As Range, MyNextRange As Range, MyRange1 As Range
    Set MyRange = Range("B8:H27")

        Sheets("Sheet1").Activate
        Range("B7:H7").copy
'this is to copy the header. Can be ommited. 
        Sheets("Sheet2").Activate
        Cells(1, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Cells(1, 1).PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    'begining of the loop. I have 16 ranges to copy from one sheet to another. The offset is 7 columns 0 rows.
        For i = 0 To 15
            Sheets("Sheet1").Activate
            Set MyRange1 = MyRange.Offset(0, i * 7)
            MyRange1.Select
            Selection.copy
            Sheets("Sheet2").Activate
            lastRow = Cells(Rows.Count, 1).End(xlUp).Row
            Cells(lastRow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Next i
'had some errors with blanks. 
    On Error GoTo Errorcatch

    Dim removeCol As Range
    On Error Resume Next
' here I select all copied ranges & select blank cells. This removes the entire row when found a blank
        For Each removeCol In Range("A2:G700").Columns
            removeCol.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Next removeCol
 ' final operation. Moves the window to row 1    
        ActiveWindow.ScrollRow = 1
      Exit Sub
    Errorcatch:
    MsgBox Err.Description
    End Sub

Что вы думаете? Какую оптимизацию я могу сделать? Есть идеи?

Спасибо всем за идеи.