Question

我有一些代码可以将列复制到新的x中。我需要将更多列从同一工作表复制到同一目标。我似乎找不到最佳的方法来做到这一点。请帮助

每列中确实都有标题。我要复制：

在新工作簿中的列y到列0
在新工作簿中的列workbook到列L
在新工作簿中的列A到列M
在新工作簿中的列B到列B

Answer 1

 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

结束子

Answer 2

由于您要复制多个范围，因此建议您将复制代码分隔到参数化的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

将长度可变的多个列复制到新工作表

2 个答案: