DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Komplike bir şey mi istedim acaba ? Yol gösterir misiniz.
Sub Ern()
Dim s1 As Worksheet, s2 As Worksheet
Dim bul As Range, satır As Long
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
Application.ScreenUpdating = False
For Each bul In s1.Range("D3:D" & s1.Range("B65536").End(3).Row)
If bul.Value > 0 Then
satır = satır + 1
bul.EntireRow.Copy
s2.Select
Cells(satır, 1).PasteSpecial
End If
Next bul
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub