Копировать таблицу вставки в переменный диапазон на основе условия и фиксированного смещения

Question

Предполагается, что макрос скопирует фиксированную таблицу 1 («E19: Q34») и вставит ее в диапазон, который составляет 15 столбцов смещения ячейки E19, то есть «T19», и будет называться «Таблица 2». в следующий раз, когда макрос будет запущен, он сможет обнаружить таблицу и продвинуться вперед на 15 столбцов до «AI19» и т. д.

Sub Macro()
Application.ScreenUpdating = False
Dim Rng, rng1, rng2 As Range, ws As Worksheet, 

Set ws = ActiveWorkbook.ActiveSheet
Set Rng = ActiveSheet.Range("E19")
Set rng1 = Rng.Offset(0, 15)
Set rng2 = ActiveSheet.Range("E19:Q34") 'fixed base range



'Copy the range with text and paste it after finding the right location

    rng2.copy

    rng1.Select

        For Each rng1 In rng1.Cells

            If rng1.Value = "" Then

                Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                ws.Paste
                Application.CutCopyMode = False
        Exit For

            Else

                Range(rng1).Address = ActiveCell.Offset(0, 15) 'attempting to change the reference of rng1 

               ' MsgBox rng1
            End If

        Next rng1
End sub

Answer 1

Попробуйте это:

Sub Macro()

    Const COL_OFFSET As Long = 15
    Dim rng, ws As Worksheet, cols As Long

    Set ws = ActiveSheet

    Set rng = ws.Range("E19:Q34")
    Application.ScreenUpdating = False

    rng.Copy
    cols = COL_OFFSET

    'find the next empty slot
    Do While Application.CountA(rng.Offset(0, cols)) > 0
        cols = cols + COL_OFFSET
    Loop

    With rng.Offset(0, cols)
        .PasteSpecial Paste:=xlValues
        .PasteSpecial Paste:=xlPasteColumnWidths
        .PasteSpecial Paste:=xlPasteFormats
    End With

End Sub