VBA Code Adjustment - Loop, copy to new sheet - arrays

Question

I have the below code from Chandoo for excel. In the 'Data Sheet' it selects the sheet to copy to according to col. C, then copies col. A - G to that spreadsheet and moves to the next entry.
I am having trouble adjusting this code to suit my spreadsheet and would appreciate some assistance. My sheet name is in col. A (not c), and I only require col. B & C to be copied to the sheet. Additionally col. B & C need to be copied into col. B & G in the spreadsheet.
Sub copyPasteData()
Dim strSourceSheet As String
Dim strDestinationSheet As String
Dim lastRow As Long
strSourceSheet = "Data entry"
Sheets(strSourceSheet).Visible = True
Sheets(strSourceSheet).Select
Range("C2").Select
Do While ActiveCell.Value <> ""
strDestinationSheet = ActiveCell.Value
ActiveCell.Offset(0, -2).Resize(1, ActiveCell.CurrentRegion.Columns.Count).Select
Selection.Copy
Sheets(strDestinationSheet).Visible = True
Sheets(strDestinationSheet).Select
lastRow = LastRowInOneColumn("A")
Cells(lastRow + 1, 1).Select
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheets(strSourceSheet).Select
ActiveCell.Offset(0, 2).Select
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Public Function LastRowInOneColumn(col)
'Find the last used row in a Column: column A in this example
'http://www.rondebruin.nl/last.htm
Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, col).End(xlUp).Row
End With
LastRowInOneColumn = lastRow
End Function
Any assistance in resolving this would be greatly appreciated.
Thank you

Answer 1

This is a leason on the dangers of copying random code form the internet. Manipulating the active selection like this is slow, hard to read, and hard to maintain.
Here's the code refactored to do this task in a more controlled fasion.
The origonal code (refactored) is included, commented out. The code modified to reference your requested cells follows each original line
Sub copyPasteData()
Dim strSourceSheet As String
Dim strDestinationSheet As String
Dim lastRow As Long
Dim wsSource As Worksheet, wsDest As Worksheet
Dim rWs As Range
Dim rSrc As Range, rDst As Range, cl As Range
strSourceSheet = "Data entry"
' Get a reference to the source sheet
Set wsSource = Worksheets(strSourceSheet)
With wsSource
' Get a reference to the list of sheet names
'Set rWs = Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp)) ' for Column C
Set rWs = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)) ' for Column A
' Loop through the sheet names list
For Each cl In rWs.Cells
' Get a reference to the current row of data, all cells on that row
'Set rSrc = cl.EntireRow.Resize(1, .Cells(cl.Row, .Columns.Count).End(xlToLeft).Column)
Set rSrc = cl.EntireRow.Cells(1, 2).Resize(1, 2) ' Reference columns B and C only
' Get a reference to the current Destination sheet
Set wsDest = Worksheets(cl.Value)
With wsDest
lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row ' Check last row in Column B
' Copy data to destination using Value array
'.Cells(lastRow + 1, 1).Resize(1, rSrc.Columns.Count).Value = rSrc.Value ' all data
.Cells(lastRow + 1, 2).Value = rSrc.Cells(1, 1) ' copy first cell to column B
.Cells(lastRow + 1, 7).Value = rSrc.Cells(1, 2) ' copy second cell to column G
End With
Next
End With
End Sub