Копирование разных диапазонов данных ячейки с одного листа на другой

Question

Мне нужно иметь возможность копировать разные диапазоны ячеек с одного листа на другой. Например, A1: A4, C3: C7, D3: D6. Мне нужно, чтобы код выполнял следующие действия:

• Скопируйте разные данные из этих ячеек на первом рабочем листе (рабочий лист1) и вставьте их в ту же строку, но транспонировали на второй рабочий лист (рабочий лист2) , Мне не нужно сохранять оригинальное форматирование.

• При вставке данных мне нужно найти последнюю строку и вставить ее под этой строкой.

Я могу написать код, который сделает большую часть этого, но я знаю только, как получить код, чтобы сделать это для одного диапазона ячеек, например, A1: A4.

Любая помощь будет принята с благодарностью.

Answer 1

Попробуйте этот код, пожалуйста.

Он скопирует выбранный диапазон и транспонирует его в набросок 2 второго листа:

Sub testCopyTransposedRanges()
  Dim sh2 As Worksheet, inpRng As Range, lastCol As Long, arrTr As Variant

  Set inpRng = Application.InputBox("Select range to be copied and transposed:", _
                                    "Range Selection", Selection.Address, Type:=8)
    If inpRng Is Nothing Then Exit Sub
    arrTr = inpRng.value
    If IsEmpty(arrTr) Then Exit Sub
    Set sh2 = Worksheets("worksheet2") ' use here your sheet name!!!
    lastCol = sh2.Cells(2, Cells.Columns.Count).End(xlToLeft).Column + 1
    sh2.Cells(2, lastCol).Resize(, UBound(arrTr)).value = WorksheetFunction.Transpose(arrTr)
End Sub

Он должен быть «отфильтрован» для «Отмена» ', выбор из нескольких столбцов et c. Но это будет сделано только в том случае, если такое решение соответствует вашим потребностям. В противном случае вы должны представить логи c, основанные на том, что нужно создать алгоритм для автоматического выбора необходимых диапазонов.

Answer 2

Хорошо, технически ТАК не сервис для написания кода, но я использую код, который в основном делает это, так что вы можете иметь его;

Sub CopyTransposeRange()

Dim shtCopy As Worksheet
Dim shtPaste As Worksheet
Dim rngCopy As Range

Set shtCopy = Sheets("Sheet1").Activate
Set shtPaste = Sheets("Sheet2")
Set rngCopy = Range("A1:A36")
'Put whatever's necessary in here to select the correct range

shtCopy.rngCopy.Copy
shtPaste.Activate
shtPaste.Range(Cells(shtPaste.UsedRange.Rows.Count + 1, 1), Cells(shtPaste.UsedRange.Rows.Count + 1, rngCopy.Rows.Count)).PasteSpecial _
xlPasteAll, xlPasteSpecialOperationNone, False, True

End Sub

Да, я знаю, активация листов не не лучшая практика, но работает для меня ¯_ (ツ) _ / ¯

надеюсь, это поможет.