Copy a range of cells and only select cells with d

Question

I'm looking for a macro to copy a range of cells, but to only copy the cells that contain a value and just the value not the formulas.

My problem is almost like this one:

Copy a range of cells and only select cells with data

I found this macro brilljant :) but it's just missing what I need :(

iMaxRow = 5000 ' or whatever the max is. 'Don't make too large because this will slow down your code.

' Loop through columns and rows
For iCol = 1 To 3 ' or however many columns you have
    For iRow = 1 To iMaxRow 

    With Worksheets("Sheet1").Cells(iRow,iCol)
        ' Check that cell is not empty.
        If .Value = "" Then
            'Nothing in this cell.
            'Do nothing.
        Else
            ' Copy the cell to the destination
            .Copy Destination:=Worksheets("Sheet2").cells(iRow,iCol)
        End If
    End With

    Next iRow
Next iCol

I hope some of you geniuses can help me. Best regards. Ringo

Answer 1

To copy all cells from the used-portion of Sheet1 columns A:C to Sheet2 as values you could use

Blank cells will be blank when copied anyhow.

Sub Better()
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
Set rng1 = ws.Range(ws.[a1], ws.Cells(Rows.Count, "A").End(xlUp))
Sheets("Sheet2").Range(rng1.Address).Value = rng1.Value
End Sub

Answer 2

Easy - Just edit the Else statement a bit...

' Loop through columns and rows
For iCol = 1 To 3 ' or however many columns you have
    For iRow = 1 To iMaxRow 

    With Worksheets("Sheet1").Cells(iRow,iCol)
        ' Check that cell is not empty.
        If .Value = "" Then
            'Nothing in this cell.
            'Do nothing.
        Else
            ' Copy the cell to the destination
            Worksheets("Sheet2").cells(iRow,iCol).value = .value
        End If
    End With

    Next iRow
Next iCol

Hope this is what you meant....