0

列名で移動する別のワークシートに列をコピーしようとしています。以下のコードの問題は、Price Calculator Status 列のみをコピーすることです。他の2つを上書きしています。このコードを変更して、上書きではなく追加するより良い方法はありますか?

Dim aCell1、aCell2、aCell3 As Range Dim strSearch As String

strSearch1 = "Change Request Description"
strSearch2 = "Current State"
strSearch3 = "Price Calculator Status"

'Set ws = ThisWorkbook.Sheets(1)

With wrkbk
    Set aCell1 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch1, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

   'Sheets("3. PMO Internal View").Columns(aCell.Column).Copy

    Set aCell2 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch2, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

    'Sheets("3. PMO Internal View").Columns(aCell.Column).Copy

    Set aCell3 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch3, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

    'If Not aCell Is Nothing Then
       ' MsgBox "Value Found in Cell " & aCell.Address & vbCrLf & _
       ' "and the column number is " & aCell.Column

        '~~> Do the copying here
        Sheets("3. PMO Internal View").Columns(aCell1.Column).Copy
        Sheets("3. PMO Internal View").Columns(aCell2.Column).Copy
        Sheets("3. PMO Internal View").Columns(aCell3.Column).Copy
    'Else
        'MsgBox "Search value not found"
    'End If
End With
4

1 に答える 1