在 Excel-Vba 中复制多列
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/28771305/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Copying Multiple columns in Excel-Vba
提问by Jain
Hi I am trying to copy multiple columns from one workbook to another, and below is the code how I copied one and need help in making the code more optimized as I don't want to write same code for all the columns. below is the code.
嗨，我正在尝试将多个列从一个工作簿复制到另一个工作簿，下面是我如何复制一个的代码，需要帮助使代码更加优化，因为我不想为所有列编写相同的代码。下面是代码。
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
I tried to put all columns in range statement but problem I found was how to paste? How can I do it for multiple columns without repeating the code? Thanks in advance.
我试图将所有列放在范围语句中，但我发现问题是如何粘贴？如何在不重复代码的情况下为多列执行此操作？提前致谢。
回答by Kyle
Let's say you want to copy columns A-D:
假设您要复制列 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
回答by Kyle Mac
I try to avoid the copy and paste functions as much as possible. To get around this I would loop through all of the values in the column and move them to your other workbook as such:
我尽量避免复制和粘贴功能。为了解决这个问题，我将遍历列中的所有值并将它们移动到您的其他工作簿中：
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
