Excelmacros将行从一个文件复制到另一个文件

我想从一个工作簿复制某些列（A，B和E）到另一个。 我写了下面的macros，在这里在计算器中的凉爽的人的帮助下，但是这个代码不是复制表格标题，如“Study Room 2100E – 2012年11月30日星期五”

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 

这是源文件 ：

这是我目前的目标文件:( 编辑包括正确的链接6:58 PM东部时间12月11日）

这是我想要的目标文件：

源文件由许多带有单独表标题的表组成。 正如你所看到的，表格的A，B和E行正在被复制，但表格标题没有被复制。 我怎样才能修改我的代码，使我目前的目标文件看起来像我想要的目标文件？ 谢谢

Answer 1

你得到结果的原因是头是合并的单元格，宽度为4个单元格，并且2列的复制/粘贴不会捕获这些单元格的值（不知道为什么）。

解决方法是首先复制值 （通过variables数组），然后复制/粘贴特殊的格式。

这将创build具有2格宽的合并单元格的标题。 复制操作后，您将需要调整标题。

请注意，您应该声明所有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 

Answer 2

尝试这个

 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