Скопируйте несколько столбцов различной длины на новый лист

Question

У меня есть код, который копирует столбец в новый workbook. Мне нужно скопировать дополнительные столбцы из того же листа в тот же пункт назначения. Я не могу найти лучший способ сделать это. Пожалуйста, помогите

У меня есть заголовки в каждом столбце. Я хочу скопировать:

• столбец L в столбец A в новой рабочей книге
• столбец M в столбец B в новой рабочей книге
• столбец B в столбец C в новой рабочей книге
• столбец C в столбец D в новой рабочей книге

---

Private Sub CommandButton1_Click()

    Dim Details As Variant, mydata As Workbook

    With ThisWorkbook.Worksheets("sheet1")
      Details = .Range(.Cells(4, "N"), .Cells(.Rows.Count, "N").End(xlUp)).Value

    End With


    Set mydata = Workbooks.Open("C:\destination file")

    With mydata.Worksheets("template")
        .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0).Resize(UBound(Details, 1), UBound(Details, 2)) = Details

    End With

End Sub

Answer 1

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

Как то так. В этом примере количество копируемых столбцов определяется из FromRange. ToRange должна быть только ячейка в левом столбце пункта назначения.

Sub CopyData(FromRange As Range, ToRange As Range)
    Dim Data As Variant

    With FromRange.Worksheet
        Data = .Range(FromRange, .Cells(.Rows.Count, FromRange.Column).End(xlUp)).Value
    End With
    With ToRange.Worksheet
        .Cells(.Rows.Count, ToRange.Column).End(xlUp).Offset(1, 0).Resize(UBound(Data, 1), UBound(Data, 2)) = Data
    End With
End Sub

Используйте это так

Sub DemoCopy()
    Dim wb As Workbook
    Dim FromRange As Range, ToRange As Range

    Set wb = Workbooks.Open("C:\destination file")
    'Copy columns L and M starting row 4, to A and B starting at next available row
    CopyData ThisWorkbook.Worksheets("sheet1").Range("L4:M4"), wb.Worksheets("template").Range("A1")
    'Copy columns B and C starting row 4, to C and D starting at next available row
    CopyData ThisWorkbook.Worksheets("sheet1").Range("B4:C4"), wb.Worksheets("template").Range("C1")
End Sub

Answer 2

 Private Sub CommandButton1_Click()
 Dim Source as workbook
 Dim SourceSheet as worksheet
 Set Source = Thisworkbook 'or as required
 Set sourcesheet = source.worksheets(1) 'or as required
 Dim Destination as Workbook
 Set Destination = Workbooks.OPen("C:\destination file") 'as required
 Dim DestSheet as Worksheet
 Set DestSheet = Destination.worksheets("Template") 'or as required
 Dim dest as range
 set dest = destsheet.range("a1")
 with sourcesheet
    .columns("L:M").copy dest
    set dest = dest.offset(0,2)
    .columns("B:C").copy dest
  end with

end sub