Wednesday, 7 August 2013

Copy Multiple Columns over by Column name

Copy Multiple Columns over by Column name

I am trying to copy Columns over to another worksheet going by Column
Name. The problem with the below code is that it copies over only the
Price Calculator Status Column. It is overwriting the other two. Is there
a better way to have this code modified so it appends rather than
overwrite?
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

No comments:

Post a Comment