Satırları harmanlamak için

[abbasonline]

Sayfa 1 de A3 hücreden sağ tarafa doğru en son hücreye kadar veriler var ve aşağı doğruda epeyce satır var, ben satırlar karışmadan bunları bir düğme vasıtası ile (Makro) harmanlamak istiyorum (Örn. A3 den sağa doğru(satır boyunca diğer hücrelerde de) Bulut YAĞMUR' un adres ve kişisel verileri var) bunların karışmaması gerekiyor.

 

[Korhan Ayhan]

Selamlar,

Keşke sorunuzu örnek dosya ile destekleyip sorsaydınız. Yanıt almanız daha da hızlanırdı.

Ben sorunuzu defalarca okumama rağmen hiçbir anlam çıkaramadım.

 

[abbasonline]

Kusura bakmayın iş yoğunluğu sebebi ile dosya ekleyememiştim, dosya ekte. Teşekkürler.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub BİLGİLERİ_HARMANLAYARAK_AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Son_Satır As Long, Sayı As Long, Satır As Long
 
    Set S1 = Sheets("Sheet1")
    Set S2 = Sheets("Sheet2")
 
    Application.ScreenUpdating = False
 
    S2.Range("A:P").Clear
    S1.Range("A1:P1").Copy S2.Range("A1")
    Son_Satır = S1.Range("A65536").End(3).Row
    Satır = 2
 
Başla:
    Randomize
    Sayı = Int((Son_Satır * Rnd) + 1)
 
    If Sayı = 1 Then Sayı = Sayı + 1
 
    If WorksheetFunction.CountIf(S2.Range("A:A"), Sayı - 1) = 0 Then
        S2.Range("A" & Satır & ":P" & Satır).Value = S1.Range("A" & Sayı & ":P" & Sayı).Value
        Satır = Satır + 1
    Else
        GoTo Başla
    End If
 
    If S2.Cells(65536, "A").End(3).Row < Son_Satır Then
        GoTo Başla
    Else
        S2.Cells.EntireColumn.AutoFit
        S2.Select
        Application.ScreenUpdating = True
        MsgBox "İşleminiz tamamlanmıştır.", vbInformation
        Set S1 = Nothing
        Set S2 = Nothing
    End If
End Sub

 

[abbasonline]

Run-time error '9':
Subscript out of range

diye hata alıyorum. Düzeldi sayfa ismini yanlış vermişim. Teşekkürler kolay gelsin.

 

[abbasonline]

Sayfa 2 ye aktarırken aynı satırdan birden fazla kopyalayıp diğer satırları bazen almıyor.ekteki dosyada uyguladım, ancak hata veriyor.

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki kodu güncelledim. İncelermisiniz.

 

[abbasonline]

Korhan bey ellerineze sağlık güzel olmuş, teşekkürler.