Soru Boş Hücreleri Dikkate Almadan Yapıştırma

[dengeceteris]

Merhabalar;
Ekte bulunan dosyam da VERİGİR sayfamda A sütununda bulunan isim listesinde aşağıya doğru boşluklar bulunuyor. Aşağıda ki gibi bir şey yazınca hepsini getiriyor. Ben bunu SONUÇ sayfama transfer ederken aradaki boşlukları yok sayarak nasıl transfer edebilirim.

Sheets("SONUÇ").Range("A3:A300" ).Value = Sheets("VERİGİR").Range("A3:A300" & son).Value

 

[numan şamil]

Merhaba Denermisiniz

Sub Numan()

Dim S1, S2 As Worksheet

Dim x, Satır As Long

Set S1 = Sheets("VERİGİR")

Set S2 = Sheets("SONUÇ")

S2.Range("A4:A" & Rows.Count).ClearContents

Application.ScreenUpdating = False

Satır = 4

For x = 4 To S1.Range("A" & Rows.Count).End(3).Row

If S1.Range("A" & x).Value <> "" Then

S2.Range("A" & Satır).Value = S1.Range("A" & x).Value

Satır = Satır + 1

End If

Next x

Application.ScreenUpdating = True

End Sub

 

[dengeceteris]

Üstad tşk ederim. Gayet güzel çalıştı

 

[numan şamil]

İyi çalışmalar

 

[FURKAN6@6]

Merhaba Denermisiniz

Sub Numan()

Dim S1, S2 As Worksheet

Dim x, Satır As Long

Set S1 = Sheets("VERİGİR")

Set S2 = Sheets("SONUÇ")

S2.Range("A4:A" & Rows.Count).ClearContents

Application.ScreenUpdating = False

Satır = 4

For x = 4 To S1.Range("A" & Rows.Count).End(3).Row

If S1.Range("A" & x).Value <> "" Then

S2.Range("A" & Satır).Value = S1.Range("A" & x).Value

Satır = Satır + 1

End If

Next x

Application.ScreenUpdating = True

End Sub

Üstadım öncelikle emeğine sağlık, bu kodla sayfa1'in ABC sütunların da bulunan bilgileri yine aynı mantıkla nasıl sayfa2'ye aktara biliriz