按列名复制多个列

Question

我正在尝试按列名将列复制到另一个工作表中。下面代码的问题是它只复制了Price Calculator Status列。它正在覆盖其他两个。有没有更好的方法来修改这段代码，让它追加而不是覆盖？

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

Answer 1

将复制行更改为：

Sheets("3. PMO Internal View").Range(Sheets("3. PMO Internal View").Columns(aCell1.Column).Address & "," & Sheets("3. PMO Internal View").Columns(aCell2.Column).Address & "," & Sheets("3. PMO Internal View").Columns(aCell3.Column).Address).Copy

这将在一个步骤中选择您的列，如range("A:A，C:C，E:E")等多个区域。逗号是文本字符串的加法，就像您在range命令中使用逗号一样，它具有不同的含义。