VBA- Copying Values from one cell to another offset cell

Question

I am trying to go through row 6 and from column 1 to 26 and search for the sentence Earned Cumulative Hours. Once that is done then I am trying to go from row 8 to the last row(30 in this case) for the column that has Earned Cumulative Hours in row 6. Then I am trying to paste the values of the cells from this column to 2 cells left in the same row. But I keep getting errors and the code doesn't work.

Can someone please point me in the right direction ? Thanks

 Sub project()

    Dim lastrow As Long
    Dim i As Long
    Dim j As Long

    lastrow = Sheets("Progress").Cells(Rows.Count, 26).End(xlUp).Row

    For j = 1 To 26
        If Cells(6, j) = "Earned Cumulative Hours" Then
            For i = 8 To lastrow
                Cells(i, j).Copy
                Cells(i, j).Offset(0, -2).Select
                Selection.PasteSpeical Paste:=xlPasteValues
            Next i
        End If
    Next j
End Sub

Answer 1

There are a few problems I can see straight away with your code. Firstly if you are offsetting back two columns .Cells(i, j).Offset(0, -2) then you will be overwriting existing values. If this is what you intend to do then weird but ok.

The next issue is that you have a problem if 'Earned Cumulative Hours' is in Column A. If this is your case Excel will be most unhappy trying to offset two columns to the left and will give an error.

In this case instead of copying and pasting it will be more efficient to set values in one column to the other which you can see in my code. Finally, your Cell references will be valid for the active sheet only. You need to qualify what worksheet you interest in as shown in my code. I normally put this at the start of the code if it is a self contained block.

You could also eliminate the i loop and set ranges of values at a time but we'll save that for next time!

I haven't test this code but it should be fine.

Sub projectawesome()

    Dim lastrow as Long, i as Long, j as Long

    'Qualify the sheet (assuming its in the activeworkbook)
    With Sheets("Progress")
        lastrow = .Cells(.Rows.Count, 26).End(xlUp).Row

        'I've changed this to column three to prevent offset errors.
        For j = 3 to 26
            If .Cells(6, j) = "Earned Cumulative Hours" Then
                For i = 8 to lastrow
                   'Assuming overwriting data is ok.
                   'No need to copy and paste
                   .Cells(i, j - 2).Value = .Cells(i, j).Value
                Next i
            End If
        Next 
    End With
End Sub

Answer 2

Try this and we can get rid of those selects

Sub project()

Dim lastrow As Long
Dim i As Long
Dim j As Long

lastrow = Sheets("Progress").Cells(Rows.Count, 26).End(xlUp).Row

For j = 1 To 26

    If Cells(6, j) = "Earned Cumulative Hours" Then

        For i = 8 To lastrow

            Cells(i, j).Copy
            With Cells(i, j)
                .Offset(0, -2).PasteSpecial xlPasteValues
            End With
        Next i ' next row
    End If
Next j ' next col
End Sub