[Løst] Flytt celler til nytt ark

[wildonln]

Kan noen hjelpe meg slik at det ikke kopieres "Entirerow", men kun B:F på linjer som har tallverdig i kol, F. 

 

 

Sub Copy_Data()

Dim Src As Worksheet, Dst As Worksheet

Dim LastRow As Long, r As Range

Dim CopyRange As Range

 

Set Src = Sheets(1)

Set Dst = Sheets(2)

LastRow = Src.Cells(Cells.Rows.Count, "A").End(xlUp).Row

For Each r In Src.Range("F4:F" & LastRow)

     If r.Value <> IsNumric Then

     If CopyRange Is Nothing Then

                Set CopyRange = r.EntireRow

        Else

                Set CopyRange = Union(CopyRange, r.EntireRow)

        End If

     End If

Next r

If Not CopyRange Is Nothing Then

CopyRange.Copy Dst.Range("A4")

End If

End Sub