Question

我正在尝试将选定列从一个工作簿的工作表复制到另一个工作簿的工作表。有10列，但我需要复制4，然后将它们粘贴到另一列。这是代码

Sub CopyCoverage()

Dim x As Workbook
Dim y As Workbook
Dim rng As Range
Dim LastRow As Long
Dim NextRow As Long

Set x = Workbooks.Open("C:\testing\abc.xlsm")
Set y = ThisWorkbook

x.Worksheets("Sheet1").Activate  // Here I need to select just 4 columns but it selects everything
Range("A65536").Select
ActiveCell.End(xlUp).Select
LastRow = ActiveCell.Row

Range("A2:A" & LastRow).Copy y.Worksheets("Sheet1").Range("a65536").End(xlUp).Offset(1, 0)
Range("B2:B" & LastRow).Copy y.Worksheets("Sheet1").Range("e65536").End(xlUp).Offset(1, 0)
Range("H1:H" & LastRow).Copy y.Worksheets("Sheet1").Range("g65536").End(xlUp).Offset(1, 0)
Range("I1:I" & LastRow).Copy y.Worksheets("Sheet1").Range("i65536").End(xlUp).Offset(1, 0)
Application.CutCopyMode = False

End Sub

我如何用一般语法编写这个？感谢。

Answer 1

尽量不要使用.select和activecell

Sub CopyCoverage()

Dim x As Worksheet, y As Worksheet, LastRow&

Workbooks.Open ("C:\testing\abc.xlsm")

Set x = Workbooks("abc.xlsm").Worksheets("Sheet1")
Set y = ThisWorkbook.Worksheets("Sheet1")

LastRow = x.Cells.SpecialCells(xlCellTypeLastCell).Row

x.Range("A2:A" & LastRow).Copy y.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
x.Range("B2:B" & LastRow).Copy y.Cells(Rows.Count, "E").End(xlUp).Offset(1, 0)
x.Range("H1:H" & LastRow).Copy y.Cells(Rows.Count, "H").End(xlUp).Offset(1, 0)
x.Range("I1:I" & LastRow).Copy y.Cells(Rows.Count, "I").End(xlUp).Offset(1, 0)

Application.CutCopyMode = False

End Sub

此外，如果表是动态的（列可能不在它们必须的位置，例如列“B”中的数据被转移到列“C”），那么您可以使用“.find”方法来获取所需的列（在标题中搜索）需要复制

Answer 2

为什么不尝试先使用更好的量程规格？您可以删除找到LastRow的代码。

Application.Intersect(Range(Cells(2, 1), Cells(ActiveWorksheet.Rows.Count, 1)), ActiveSheet.UsedRange).Copy

上面的代码将选择A列中的所有数据，无论它是否是连续的。更改Cells（）函数中的第二个坐标以更改列。所以Cells（1,1）= A1，Cells（2,1）= A2，Cells（1,2）= B1等

接下来，您需要在单独的行中激活ThisWorkbook。类似的东西：

y.Activate
y.Sheets("Sheet1").Activate
Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Offset(1,0).Select
ActiveSheet.Paste

然后返回并执行其他三列：

x.Activate
Application.Intersect(Range(Cells(2, 2), Cells(ActiveSheet.Rows.Count, 2)), ActiveSheet.UsedRange).Copy
y.Activate
y.Sheets("Sheet1").Activate
Cells(ActiveSheet.Rows.Count, 2).End(xlUp).Offset(1,0).Select
ActiveSheet.Paste

依此类推，直到你开心。希望有所帮助！马特，通过ExcelArchitect.com

在VBA中复制粘贴多个列

2 个答案: