复制Excel中的表格中的数据

时间:2015-03-24 13:45:34

标签: excel vba excel-vba

我正在尝试将数据传输/复制到Excel工作表中的表格中。我编写了以下代码,如果没有表格和正常结构,则可以使用。

Sub TransferData()

Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets("OverRides")
lastrow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

Range("B5:B" & lastrow).CopyThisWorkbook.Worksheets("Sheet1").Range("a65536").End(xlUp).Offset(1, 3)
Range("C5:C" & lastrow).Copy ThisWorkbook.Worksheets("Sheet1").Range("a65536").End(xlUp).Offset(1, 2)
Range("A5:A" & lastrow).Copy ThisWorkbook.Worksheets("Sheet1").Range("a65536").End(xlUp).Offset(1, 1)
Application.CutCopyMode = False

End Sub

现在数据已经传输,但是像

这样的瀑布模式
                                                          1
                                                          2
                                                          3
                                                          4
                                   A
                                   B
                                   C
                                   D
      !
      @
      $
      %

假设这是3列和4行数据。任何人都可以纠正吗?

我希望的结果是这些数据应该与其他数据一起复制。

Old Data              Old Data                Old Data
    !                     A                      1
    @                     B                      2
    $                     C                      3
    %                     D                      4

1 个答案:

答案 0 :(得分:0)

问题在于,即使在复制第一组数据后,您也“找到”要复制数据的范围。它在线:

ThisWorkbook.Worksheets("Sheet1").Range("a65536").End(xlUp).Offset(...)

所以只需保存该范围并从中偏移:

Sub TransferData()

Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets("OverRides")
lastrow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

Dim startRange as Range 'save the range to this variable
set startRange = ThisWorkbook.Worksheets("Sheet1").Range("a65536").End(xlUp)

Range("B5:B" & lastrow).Copy startRange.Offset(1, 3)
Range("C5:C" & lastrow).Copy startRange.Offset(1, 2)
Range("A5:A" & lastrow).Copy startRange.Offset(1, 1)

Application.CutCopyMode = False

End Sub