error in loop

[kutbishikari]

here is my code

Sub hawally()
Application.ScreenUpdating = False
Set i = Sheets("Sheet3")
Set e = Sheets("HW")
Dim d As Integer
Dim j As Integer
d = 1
j = 2
e.Range("A2:D100").Clear

Do Until IsEmpty(i.Range("D" & j))
If i.Range("D" & j) > 0 Then
d = d + 1
e.Range("A" & d & ":D" & d & "").Value = i.Range("A" & j & ":D" & j & "").Value
End If
j = j + 1
Loop
Sheets("HW").Select
Application.ScreenUpdating = True

End Sub

my sheet has 700 rows with 10 columns , somewhere no numbers in the loop column , then it giving me mis type error and exit sub ,
i would like to go next by skip that error

my sheet look like

A B C D
df fr gt 8
df fr gt 6
df fr gt 4
df fr gt #value!
df fr gt 7
df fr gt 6

i would like to get result as below :
df fr gt 8
df fr gt 6
df fr gt 4
df fr gt 7
df fr gt 6

 

[AlphaFrog]

Try something like this...

Sub hawally2()

    Dim ws3 As Worksheet, wsHW As Worksheet
    Dim LastRow As Long
    
    Application.ScreenUpdating = False
    
    Set ws3 = Sheets("Sheet3")
    Set wsHW = Sheets("HW")

    wsHW.Range("A2", wsHW.Range("D" & Rows.Count).End(xlUp).Offset(1)).ClearContents
    
    With ws3
    
        LastRow = .Range("D" & Rows.Count).End(xlUp).Row
        
        .Range("D1:D" & LastRow).AutoFilter Field:=1, Criteria1:=">0"
        
        .Range("A2:D" & LastRow).SpecialCells(xlCellTypeVisible).Copy
        wsHW.Range("A2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
        
        Application.CutCopyMode = False ' Clear clipboard
        .AutoFilterMode = False         ' Clear autofilter
        
    End With
    
    wsHW.Select
    Application.ScreenUpdating = True

End Sub

 

[kutbishikari]

Thanks AlphaFrog for your quick reply but it doesn't work , error 400 and nothing coping , marco taking long time ,previos code fast very fast

forget to mention sheet3 is a hidden sheet and it has 700 rows and 12 columns linked by some another sheets

your help will be appricaited

 

[AlphaFrog]

Then to keep it simple...

Sub hawally()
Application.ScreenUpdating = False
Set i = Sheets("Sheet3")
Set e = Sheets("HW")
Dim d As Integer
Dim j As Integer
d = 1
j = 2
e.Range("A2:D100").Clear

Do Until IsEmpty(i.Range("D" & j))
If Not IsError(i.Range("D" & j)) Then
If i.Range("D" & j) > 0 Then
d = d + 1
e.Range("A" & d & ":D" & d & "").Value = i.Range("A" & j & ":D" & j & "").Value
End If
End If
j = j + 1
Loop
Sheets("HW").Select
Application.ScreenUpdating = True

End Sub

 

[kutbishikari]

Thank you very much for your support