열 이름별로 여러 열 복사

Question

열 이름별로가는 다른 워크 시트로 열을 복사하려고합니다. 아래 코드의 문제점은 Price Calculator Status Column 만 복사한다는 것입니다. 다른 두 개를 덮어 씁니다. 이 코드를 수정하여 덮어 쓰는 것이 아니라 추가하는 더 좋은 방법이 있습니까?

희미한 aCell1, aCell2, aCell3으로 범위 희미한 strSearch으로 문자열

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 

을 ("A : A, C : C, E : E"). 쉼표는 범위 명령에서 쉼표를 사용하는 것과는 다른 의미를 갖는 것처럼 텍스트 문자열 추가입니다.