makroda sadece değer olan hücreleri seçmek

[aserifkuzu]

A sütununa düşeyara ile değer çekiyorum ilk 10 satıra (10 satır formüllü).. duruma göre 5-7 satır değer bulup çekiyor kalan satırlar değer bulamadığı için boş kalıyor..
daha sonra makro kaydediyorum, A1 den (ctrl+shift+aşağı ok) ile değerleri seçiyorum.. sorun burda başlıyor.. 7 satırda değer var mesela ama 10 satır formüllü olduğu için 10 satırı seçiyor (ctrl + shift + aşağı ok) ile.. olmasını istediğim değeri olan kadar satırı seçmesi(7 satır)..
Diyelim ki üstte ki olmadı 10 satırıda seçtik ve hedefe değer olarak yapıştırdık.. 7 satır değer 3 satır boş olarak yapıştı.. makroyu kaydettik tuşa atadık.. bundan sonra yeniden işlemi kullanacağız, bu sefer 6 veri çektik düşey ara ile kalan 4 satır düşeyara değer bulamadığı için boş.. tuşa bastık, makro kopyaladı 10 satırı, hedefe sayfaya gitti, A100000 hücreye gitti, (ctrl + yukarı ok) ile son hücreyi bulup yapıştıracak.. bulduğu son hücre "ilk yapıştırdığımız 10 satırın 10. satırı... oraya yapıştırınca ilk gelen değerler ile şimdiki gelen değerler arasında boşluk oluyor ve her yeni gelen değer ile bir önceki değer arasında boşluk kalıyor..
bu sorunumu nasıl aşarım dostlar yardım edin
teşekkür ederim

[lark]

Örnek dosya ekler misiniz.

[aserifkuzu]

REZERVLER SAYFASINDA İŞARETLEDİĞİM SATIRLAR ARKAPLAN SAYFASINDA AK1 SATIRINDAN İTİBAREN SIRALANIYOR.. İŞARETLEMEME GÖRE SIRALANANLARIN SAYISI DEĞİŞİYOR.. REZERVLER SAYFASINDA Kİ YARIM AY İŞARETİNE TIKLAYINCA ARKAPLANDAN HEPSİNİ SEÇİP "STOK HAREKETLERİ" SAYFASINA YAPIŞTIRIYOR VE DEDİĞİM GİBİ BOŞLUKLAR OLUŞUYOR

[lark]

Yarım ay'a tıklayarak yaptığınız asıl işlemin makrosu (REZERVİŞLE) eksik. Boşluğu nerede yaratıyor test edemiyorum.

[aserifkuzu]

aa özür dilerim en son o makroyu silmiştim. tekrar kayıt edip öyle yollarım

[aserifkuzu]

EKLEDİM. İKİNCİ KEZ YARIM AYA BASTIĞINIZDA BOŞLUĞU GÖRECEKSİNİZ

[lark]

Dener misiniz.

Kod: [Seç]

Sub REZERVİŞLE()
'
' REZERVİŞLE Makro
'
Dim q As Integer
Application.ScreenUpdating = False
    For q = 0 To 11
    Sheets("ARKA PLAN").Select
    Range("AK1").Select
    ActiveCell.Offset(q, 0).Range("A1").Select
    If Selection = "" Then
    GoTo x:
    Else
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("STOK HAREKETLERİ").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    ActiveCell.Select
    Next
x:
Application.CutCopyMode = False
Sheets("REZERVLER").Select
Application.ScreenUpdating = True
End Sub

[aserifkuzu]

teşekkür ederim..