Bos satır sılme

[alpsey]

Selam arkadaslar benım sorunum gondermıs oldugum tabloda englısh-turkısh dekı yanlısları travaıl adlı bolumde gosterdım ancak yapmıs oldugum yanlısların alt alta gelmesını ıstıyorum yardımcı olursanız sevınırım.travaıl bolumunde englısh-turkısdekı yapmıs oldugum yanlıslar buraya aktralıyor ancak dogru yaptıgımda yanlıslar aktarılmıyor dolayısıyla bu hucrelerde verı var ben yapmıs oldugum yanlısların ordakı verılerı sılmeden nasıl alta atla getırırım saygılar...BU ARADA SAYFA KORUMASININ SİFRESİ 3810 DUR YARDIMCI OLURSANIZ SEVİNİRİM

 

[Ömer]

Merhaba,

Veri aralığınız fazla olduğu için aktarım yaparken formülleri değil aşağıdaki kodları kullanmanız daha hızlı işlem yapmanızı sağlayacaktır.

Sub Aktar()
Dim i As Long, s1 As Worksheet, s2 As Worksheet
Dim sat1 As Long, sat2 As Long
Set s1 = Sheets("ENGLISH-TURKISH")
Set s2 = Sheets("TURKISH-ENGLISH")
Application.ScreenUpdating = False
Sheets("TRAVAIL").Select
Range("A:I").ClearContents
sat1 = 1: sat2 = 1
    For i = 1 To s1.[A65536].End(3).Row
        If s1.Cells(i, "c") + 0 = 0 Then
            Range("A" & sat1 & ":D" & sat1).Value = _
            s1.Range("A" & i & ":D" & i).Value
            sat1 = sat1 + 1
        End If
    Next i
    For i = 1 To s2.[A65536].End(3).Row
        If s2.Cells(i, "c") + 0 = 0 Then
            Range("F" & sat2 & ":I" & sat2).Value = _
            s2.Range("A" & i & ":D" & i).Value
            sat2 = sat2 + 1
        End If
    Next i
Application.ScreenUpdating = True
End Sub

.

 

[alpsey]

teşekkürler bir deneyeyim