For loop not working as intended bu not giving any errors

Question

unused_row = report.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    
    For Each rng In export.Range("D1:D600")
        If Not IsEmpty(rng) Then
            Set ferie = rng.Offset(0, 17)
            Set permessi = rng.Offset(1, 17)
            Set flessibilita = rng.Offset(2, 17)
        ferie.Copy report.Range("b" & unused_row)
        permessi.Copy report.Range("c" & unused_row)
        flessibilita.Copy report.Range("d" & unused_row)
        End If
    Next

I have the following code that is not working as intended. It should loop through each cell in export.Range("D1:D600") and copy in another sheet on columns B trough D (using the latest unused row to not overwrite data) the values specified in the offset from where the loop is arrived at, specified with rng.

The code runs without any errors but does not copy the required data.

Any ideas?

Answer 1

Copy to Another Worksheet

• Export and Report are the code names of two worksheets in the workbook containing this code.
• To copy to the next row you have to do unused_row = unused_row + 1 at the end of the If statement.
• I've opted for using a cell range and for offsetting it at the beginning of the loop as an alternative.
• If e.g. you put the ...End(xlup)... line in the loop (not recommended), then you have to make sure it calculates on column 2 ("B") since you're not writing to column 1 ("A").
• Those three 'intermediate' range variables seem kind of useless. See Tests 2-4 without them.

Option Explicit

Sub Test1() ' copy values, formats and formulas
    
    Dim dCell As Range: Set dCell = Report.Cells(Report.Rows.Count, "B") _
        .End(xlUp) ' last occupied destination cell
    
    Dim ferie As Range, permessi As Range, flessibilita As Range
    Dim sCell As Range
    
    For Each sCell In Export.Range("D1:D600").Cells
        If Not IsEmpty(sCell) Then
            Set dCell = dCell.Offset(1) ' next destination cell
            With sCell
                Set ferie = .Offset(0, 17)
                Set permessi = .Offset(1, 17)
                Set flessibilita = .Offset(2, 17)
            End With
            With dCell
                ferie.Copy .Offset(, 0)
                permessi.Copy .Offset(, 1)
                flessibilita.Copy .Offset(, 2)
            End With
        End If
    Next

End Sub

Sub Test2() ' copy values, formats and formulas
    
    Dim dCell As Range: Set dCell = Report.Cells(Report.Rows.Count, "B") _
        .End(xlUp) ' last occupied destination cell
    
    Dim sCell As Range
    
    For Each sCell In Export.Range("D1:D600").Cells
        If Not IsEmpty(sCell) Then
            Set dCell = dCell.Offset(1) ' next destination cell
            sCell.Offset(0, 17).Copy dCell.Offset(, 0)
            sCell.Offset(1, 17).Copy dCell.Offset(, 1)
            sCell.Offset(2, 17).Copy dCell.Offset(, 2)
        End If
    Next sCell

End Sub

Sub Test3() ' copy only values; more efficient
    
    Dim dCell As Range: Set dCell = Report.Cells(Report.Rows.Count, "B") _
        .End(xlUp) ' last occupied destination cell
    
    Dim sCell As Range
    
    For Each sCell In Export.Range("D1:D600").Cells
        If Not IsEmpty(sCell) Then
            Set dCell = dCell.Offset(1) ' next destination cell
            dCell.Offset(, 0).Value = sCell.Offset(0, 17).Value
            dCell.Offset(, 1).Value = sCell.Offset(1, 17).Value
            dCell.Offset(, 2).Value = sCell.Offset(2, 17).Value
        End If
    Next sCell

End Sub

Sub Test4() ' copy only values shorter; more efficient
    
    Dim dCell As Range: Set dCell = Report.Cells(Report.Rows.Count, "B") _
        .End(xlUp) ' last occupied destination cell
    
    Dim sCell As Range
    Dim i As Long
    
    For Each sCell In Export.Range("D1:D600").Cells
        If Not IsEmpty(sCell) Then
            Set dCell = dCell.Offset(1) ' next destination cell
            For i = 0 To 2
                dCell.Offset(, i).Value = sCell.Offset(i, 17).Value
            Next i
        End If
    Next sCell

End Sub