Option Explicit
Sub without_zeros()
Dim Source_Array As Variant
Dim Target_Array()
Dim n%, i%
With Sheets("ورقة1")
Source_Array = .Range("K3").CurrentRegion
.Range("D3").Resize(UBound(Source_Array), 2).Clear
For i = 1 To UBound(Source_Array)
If Source_Array(i, 1) <> 0 Then
n = n + 1
ReDim Preserve Target_Array(1 To 2, 1 To n)
Target_Array(1, n) = Source_Array(i, 1)
Target_Array(2, n) = Source_Array(i, 2)
End If
Next i
If n Then
.Range("D3").Resize(n, 2) = _
Application.Transpose(Target_Array)
.Range("K3").CurrentRegion.Copy
.Range("D3").Resize(n, 2).PasteSpecial 4
Application.CutCopyMode = False
.Range("D3").Select
End If
End With
End Sub