复制Excel-Vba中的多个列

您好我想从一个工作簿复制多个列到另一个，下面是代码如何复制一个，需要帮助，使代码更优化，因为我不想为所有列编写相同的代码。 下面是代码。

Sub Copymc() Dim x As Workbook Dim y As Workbook Set x = Workbooks.Open("H:\testing\demo\test2.xlsx") Set y = Workbooks.Open("H:\testing\demo\test1.xlsx") Dim LastRow As Long Dim NextRow As Long ' determine where the data ends on Column B Sheet1 x.Worksheets("Sheet1").Activate Range("A65536").Select ActiveCell.End(xlUp).Select LastRow = ActiveCell.Row ' copy the data from Column B in Sheet 1 Range("A2:A" & LastRow).Copy ' Determine where to add the new data in Column C Sheet 2 y.Worksheets("Sheet1").Activate Range("A65536").Select ActiveCell.End(xlUp).Offset(1, 0).Select NextRow = ActiveCell.Row ' paste the data to Column C Sheet 2 y.Worksheets("Sheet1").Range("A" & NextRow).Select ActiveSheet.Paste Application.CutCopyMode = False Range("A1").Select End Sub 

我试图把所有列在范围声明，但我发现的问题是如何粘贴？ 我怎么能做到多列而不重复的代码？ 提前致谢。

Answer 1

假设你想复制列AD：

 Sub Copymc() Dim x As Workbook Dim y As Workbook Set x = Workbooks.Open("H:\testing\demo\test2.xlsx") Set y = Workbooks.Open("H:\testing\demo\test1.xlsx") Dim LastRow As Long Dim NextRow As Long ' determine where the data ends on Column B Sheet1 x.Worksheets("Sheet1").Activate Range("A65536").Select ActiveCell.End(xlUp).Select LastRow = ActiveCell.Row ' copy the data from Column B in Sheet 1 Range("A2:D" & LastRow).Copy y.worksheets("Sheet1").range("a65536").end(xlup).offset(1,0) ' Determine where to add the new data in Column C Sheet 2 'y.Worksheets("Sheet1").Activate 'Range("A65536").Select 'ActiveCell.End(xlUp).Offset(1, 0).Select 'NextRow = ActiveCell.Row ' paste the data to Column C Sheet 2 'y.Worksheets("Sheet1").Range("A" & NextRow).Select 'ActiveSheet.Paste Application.CutCopyMode = False Range("A1").Select End Sub 

Answer 2

我尽量避免复制和粘贴function。 为了解决这个问题，我将遍历列中的所有值，并将它们移到其他工作簿中，如下所示：

 Sub test() Dim x As Workbook Dim y As Workbook Set x = Workbooks.Open("H:\testing\demo\test2.xlsx") Set y = Workbooks.Open("H:\testing\demo\test1.xlsx") Dim LastRow As Long LastRow = x.Sheets("Sheet1").Range("A65536").End(xlUp).Row For i = 1 To LastRow CopyVal = x.Sheets("Sheet1").Range("A1").Offset(i, 0).Value CopyVal2 = x.Sheets("Sheet1").Range("A1").Offset(i, 1).Value CopyVal3 = x.Sheets("Sheet1").Range("A1").Offset(i, 2).Value CopyVal4 = x.Sheets("Sheet1").Range("A1").Offset(i, 3).Value y.Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 3).Value = CopyVal4 y.Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 2).Value = CopyVal3 y.Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 1).Value = CopyVal2 y.Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0).Value = CopyVal Next End Sub