Скопируйте диапазон данных, затем вставьте его (автоматически разделить) в несколько столбцов

Question

Можно ли скопировать диапазон данных и при вставке он будет автоматически разделен на несколько столбцов (каждый столбец имеет одинаковое количество строк).Как показано на этом рисунке ниже, я хочу скопировать данные B2: B9 и затем автоматически вставить их в D2: D8, E2: E8, F2: F8. рисунок вопроса

Я новичок в vba, пока я пытался использовать макросъемку, но не могу этого сделать.Прошу прощения за мой английский, пожалуйста, помогите!

Range("B2:B19").Select
Selection.copy

Range("D2:D8").Select
ActiveSheet.Paste

Range("E2:E8").Select
ActiveSheet.Paste

Range("F2:F8").Select
ActiveSheet.Paste

Answer 1

Вам просто нужны функции изменения размера и смещения в сочетании с некоторыми базовыми математическими навыками.

Option Explicit

Sub splitCopy()

    Dim srng As Range, trng As Range
    Dim i As Long, n As Long, xsplit As Long, xrows As Long

    xsplit = 3  'number of target columns
    xrows = 7   'number of target rows

    With Worksheets(1)

        Set srng = .Range("B2:B19")
        Set trng = .Range("D2")

        For i = 0 To xsplit - 1
            n = Application.Min(xrows, srng.Rows.Count - xrows * i)
            srng.Resize(n, 1).Offset(i * xrows, 0).Copy _
                Destination:=trng.Offset(0, i)
        Next i

    End With

End Sub

Answer 2

Option Explicit

Sub TEST()

     With ThisWorkbook.Worksheets("Sheet1")

        .Range("B2:B8").Copy .Range("D2:D8")
        .Range("B9:B15").Copy .Range("E2:E8")
        .Range("B16:B19").Copy .Range("F2:F4")

     End With

End Sub

Код не делит автоматически весь диапазон, потому что вы не указываете число, которое хотите, чтобы ваш диапазон был разделен.