Excel宏将行从一个文件复制到另一个文件

Question

我想将某些列（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

这是source file：

这是我的 current target 文件：（已编辑以包含正确的链接，美国东部标准时间 12 月 11 日下午 6:58）

这是我的desired target 文件：

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

Answer 1

您得到结果的原因是标题是合并的单元格，4 个单元格宽，2 列的复制/粘贴没有捕获这些单元格中的值（不知道为什么）。

解决方法是先复制 Values（通过变体数组），然后复制/粘贴特殊格式。

这将创建包含 2 个单元格宽的合并单元格的标题。您需要在复制操作后调整标题。

注意，你应该声明所有你的变量

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