vba Excel宏将行从一个文件复制到另一个文件
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/13830505/
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
Excel Macro to copy rows from one file to another
提问by Amatya
I want to copy certain columns (A,B and E) from one workbook to another. I wrote the following Macro, with the help of cool people here at stackoverflow, but this code is not copying the table headings like "Study Room 2100E - Friday, Nov 30 2012"
我想将某些列（A、B 和 E）从一个工作簿复制到另一个。我在 stackoverflow 上很酷的人的帮助下编写了以下宏，但是这段代码没有复制表格标题，例如“Study Room 2100E - Friday, Nov 30 2012”
Sub CopyColumnToWorkbook()
Dim sourceColumn As Range, targetColumn As Range
Set sourceColumn = Workbooks("Source.xlsm").Worksheets(1).Columns("A:B" & lr)
Set targetColumn = Workbooks("Target.xlsm").Worksheets(1).Columns("A:B")
Set sourceColumn2 = Workbooks("Source.xlsm").Worksheets(1).Columns("E" & lr)
Set targetColumn2 = Workbooks("Target.xlsm").Worksheets(1).Columns("C")
sourceColumn.Copy Destination:=targetColumn
sourceColumn2.Copy Destination:=targetColumn2
End Sub
This is the source file:
这是源文件：
This is what my current targetfile: (EDITED TO INCLUDE CORRECT LINK 6:58PM EST Dec 11)
这就是我当前的目标文件：（编辑为包括正确的链接 EST 12 月 11 日下午 6:58）
This is my desired targetfile:
这是我想要的目标文件：
The Source file consists of many tables with separate table headings. As you can tell, the rows A,B and E of the tables are being copied but the table headings are not being copied. How can I modify my code so my current target file looks like my desired target file? Thanks
源文件由许多具有单独表格标题的表格组成。如您所知，正在复制表的 A、B 和 E 行，但未复制表标题。如何修改我的代码，使我当前的目标文件看起来像我想要的目标文件？谢谢
回答by chris neilsen
The reason you get the result you do is that the headers are merged cells, 4 cells wide and the copy/paste of 2 columns does not capture the values from these cells (don't know why).
您得到结果的原因是标题是合并的单元格，宽 4 个单元格，并且 2 列的复制/粘贴未捕获这些单元格中的值（不知道为什么）。
A work around is to copy the Valuesfirst (via a variant array) and then copy/paste special the formats.
解决方法是首先复制值（通过变体数组），然后复制/粘贴特殊格式。
This will create headers with merged cells 2 cells wide. You will need to adjust the headers after the copy operation.
这将创建合并单元格宽度为 2 个单元格的标题。复制操作后，您需要调整标题。
Note, you should declare allyour variables
请注意，您应该声明所有变量
Option Explicit ' First line in Module
Sub CopyColumnToWorkbook()
Dim sourceColumn As Range, targetColumn As Range
Dim sourceColumn2 As Range, targetColumn2 As Range
Dim lr As String ' <-- don't know what this is for, left it in as it's in your OP
Dim rw As Range
Set sourceColumn = Workbooks("Source.xlsm").Worksheets(1).UsedRange.Columns("A:B" & lr)
Set targetColumn = Workbooks("Target.xlsm").Worksheets(1).Columns("A:B").Resize(sourceColumn.Rows.Count)
' Copy values
targetColumn = sourceColumn.Value
' Copy Format
sourceColumn.Copy
targetColumn.PasteSpecial xlPasteFormats
Set sourceColumn2 = Workbooks("Source.xlsm").Worksheets(1).Columns("E" & lr)
Set targetColumn2 = Workbooks("Target.xlsm").Worksheets(1).Columns("C")
sourceColumn2.Copy Destination:=targetColumn2
' Adjust Headers
For Each rw In targetColumn.Rows
If rw.MergeCells Then
rw.Resize(1, 4).Merge
' Appy cell format to headers here if required
rw.Font.Size = 18
' etc ...
End If
Next
End Sub
回答by Andrey Gordeev
Try this
尝试这个
Sub CopyColumnToWorkbook()
Dim sourceColumn As Range, targetColumn As Range
Set sourceColumn = Workbooks("Source.xlsm").Worksheets(1).Columns("A:G" & lr)
Set targetColumn = Workbooks("Target.xlsm").Worksheets(1).Columns("A:G")
sourceColumn.Copy Destination:=targetColumn
Workbooks("Target.xlsm").Worksheets(1).Columns("C:D").EntireColumn.Delete
Workbooks("Target.xlsm").Worksheets(1).Columns("D:E").EntireColumn.Delete
End Sub
