aktarılan hücre dolu ise yan hücreye aktarsın

[sdegirmenci]

Değerli hocalarım merhaba;
Ekteki dosyam üzerinde de açıkladığım gibi diğer sayfaya kod ile aktarmak istediğim veri ; o hücre dolu ise bir sağa , oda dolu ise yine bir sağ hücreye aktarılsın. Çok uğraştım alt alta aktarabiliyorum ama bu şekilde yapamadım. Yardımcı olursanız sevinirim. Saygılarımla.

 

[ozgretmen]

Benzer Sayfa2 de benzer firmalar var.Biz Sayfa1 deki verileri hangisine aktaracağız ? Biraz açıklar mısın ?

 

[sdegirmenci]

Merhaba ; Öncelikle ilginize teşekkür ederim.
Sayfa 1 de örnek aaaa firmasına 2009 yılında gelen yetkiyi ikinci sayfadaki tabloya aktaracağız.eğer 2009 yılının Yetki 1 sütunu dolu ise yetki 2 sütununa aktarsın

 

[janveljan]

Dosya ekte, 4 yetki yazmış olduğunuz için yana doğru sadece 4 hücreyi arıyor, diğer türlü j değişkeninin üst sınırını değiştirmek gerekir.

Sub aktar()
For i = 1 To [A65536].End(xlUp).Row
aranan = Sheets("Sayfa1").Cells(i, 1) & Sheets("Sayfa1").Cells(i, 2)
    Sheets("Sayfa2").Select
    For k = 4 To Sheets("Sayfa2").[B4].End(xlDown).Row
        If aranan = Sheets("Sayfa2").Cells(k, 2) & Sheets("Sayfa2").Cells(k, 3) Then
            For j = 1 To 4
                If Sheets("Sayfa2").Cells(k, j + 3).Value = "" Then
                    Sheets("Sayfa2").Cells(k, j + 3).Value = Sheets("Sayfa1").Cells(i, 3).Value
                    Exit For
                End If
            Next
        End If
    Next
Next
End Sub

 

[sdegirmenci]

Sayın janveljan;
İlginize çok teşekkür ederim. Dosyama uyarladım. tam istediğim gibi. İşleriniz kolay gelsin .

 

[ozgretmen]

Alternatif olsun...

Sub aktar()
Sheets("Sayfa2").Activate
For i = 4 To [B65536].End(3).Row
If Sheets("Sayfa1").[A1] = Cells(i, "B") And Sheets("Sayfa1").[B1] = Cells(i, "C") Then
For k = 4 To 7
If Cells(i, k) = "" Then
Cells(i, k) = Sheets("Sayfa1").[C1]
Exit For
End If
Next k
End If
Next i
MsgBox " İşlem Tamamdır..."
End Sub