Question

我想将某些列（A，B和E）从一个工作簿复制到另一个工作簿。我写了下面的宏，在stackoverflow的酷人的帮助下，但是这段代码并没有像“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

这是source file：

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

这是我的desired target文件：

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

Answer 1

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

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

这将创建包含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

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

2 个答案: