How to copy and paste rows conditionally with for

Question

I'm using the following code to attempt to dynamically copy a list to another worksheet. It runs, but instead of copying, it just deletes all of column E on the source worksheet, and doesn't move anything to the destination worksheet. I'm not sure what's going on, any suggestions?

Option Explicit

Sub findCells()

Dim topCell As String
Dim leftCell As String
Dim refCell As Range
Dim sht As Worksheet
Dim lastRow As Long
Dim i As Long

Set refCell = ActiveCell

topCell = refCell.End(xlUp).Value
leftCell = refCell.End(xlToLeft).Value

MsgBox topCell
MsgBox leftCell

Worksheets(topCell).Activate

Set sht = Worksheets(topCell)

lastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
MsgBox lastRow

For i = 1 To lastRow
    Dim cellVal As String
    Dim altCounter As Integer
    altCounter = 31
    Cells(i, 5).Value = cellVal
    If leftCell = cellVal Then
    Dim crange As Range
    altCounter = altCounter + 1
     Let crange = "A" & i & ":" & "G" & i
     Range(crange).Copy Worksheets("Summary").Range("A" & altCounter & ":" & "G" & altCounter)
    End If
Next i

End Sub

Answer 1

This is not the full answer, but you have some errors inside your For i = 1 To lastRow loop (and it's too long to write as a comment).

First, fully qualify your Cells and Range with your defined and set sht object.

Second, there is no need to declare your variables (cellVal, altCounter and crange) every time you enter the loop.

Third, to set a range, this Let crange = "A" & i & ":" & "G" & i will result with an error, you need to use Set crange = .Range("A" & i & ":" & "G" & i).

Fourth, no where in your code you are giving a value to cellVal, so I think your syntax in Cells(i, 5).Value = cellVal meant to be cellVal = .Cells(i, 5).Value

Dim cellVal As String
Dim altCounter As Long '<-- use Long instead of Integer
Dim crange As Range

With sht        
    altCounter = 31
    For i = 1 To lastRow
        cellVal = .Cells(i, 5).Value
        If leftCell = cellVal Then
            altCounter = altCounter + 1
            Set crange = .Range("A" & i & ":" & "G" & i)
            crange.Copy Worksheets("Summary").Range("A" & altCounter & ":" & "G" & altCounter)
        End If
    Next i
End With

Answer 2

This is too long for a comment as well, but thanks Shai Rado--that was a complete answer and the code worked after I implemented.

However, after I edited to be the below, it stopped working. It doesn't kick up an error, just doesn't copy and paste the rows as it had before.

I'm not sure what's happening, but when I use MsgBox to validate some parts of the code, it looks like it's the loop that isn't functioning. But, without kicking up an error, I don't know why.

Option Explicit

Sub findCells()

Dim topCell As String
Dim leftCell As String
Dim refCell As Range
Dim sht As Worksheet
Dim lastRow As Long
Dim i As Long
Dim cellVal As String
Dim altCounter As Long
Dim crange As Range
Dim rangeToDelete As Range

Set rangeToDelete = Worksheets("Summary").Cells(31, "A").CurrentRegion
    rangeToDelete.Value = ""

Set refCell = ActiveCell

topCell = refCell.End(xlUp).Value
leftCell = refCell.End(xlToLeft).Value

Set sht = Worksheets(topCell)

lastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

With sht
    .Range("A1:G1").Copy Worksheets("Summary").Range("A31:G31")
    altCounter = 31
    For i = 1 To lastRow
        cellVal = Cells(i, 5).Value
        If leftCell = cellVal Then
            altCounter = altCounter + 1
            Set crange = .Range("A" & i & ":" & "G" & i)
            crange.Copy Worksheets("Summary").Range("A" & altCounter & ":" & "G" & altCounter)
        End If
    Next i
End With

End Sub