0

あるワークブックから別のワークブックに特定の列 (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

これはソースファイルです:

これは私の現在のターゲットファイルです：（正しいリンクを含めるように編集された12月11日午後6時58分EST）

これは私の目的のターゲットファイルです:

ソース ファイルは、個別のテーブル ヘッダーを持つ多くのテーブルで構成されています。ご覧のとおり、テーブルの行 A、B、E はコピーされていますが、テーブルの見出しはコピーされていません。現在のターゲット ファイルが目的のターゲット ファイルのように見えるようにコードを変更するにはどうすればよいですか? ありがとう

4

2 に答える 2

2

結果が得られる理由は、ヘッダーが結合されたセルであり、幅が 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
于 2012-12-12T05:33:55.420 に答える
1

これを試して

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
于 2012-12-12T05:37:47.393 に答える