Ada göre aktarma

[boztepelibey]

Selamün Aleyküm;

ALLAH cc rahmeti af ve mağfireti üzerinize olsun inşallah.

ÜSTADIM, Ekli dosyada arz ettiğim konu hakkında yardımlarınızı bekliyorum.


Selam ve Dua İle

 

[leumruk]

Merhaba,

Sub Aktar()
Set S1 = Sheets("Sayfa1")
For Syf = 2 To Sheets.Count
    Sheets(Syf).Range("c3:d65536").ClearContents
    For x = 2 To S1.[a65536].End(3).Row
        If Sheets(Syf).[a1] = Cells(x, "a") Then
            Sat = Sheets(Syf).[c65536].End(3).Row + 1
            Sheets(Syf).Cells(Sat, "c") = S1.Cells(x, "b")
            Sheets(Syf).Cells(Sat, "d") = S1.Cells(x, "c")
        End If
    Next
Next
End Sub

 

[boztepelibey]

ÜSTADIM ;

Teşekkür Ettim Allah Razı Olsun.

Zahmet verdim Hakkını Helal Et

 

[boztepelibey]

ÜSTADIM
Bunu formül ile yaparsak nasıl yapabiliriz?

 

[leumruk]

ÜSTADIM
Bunu formül ile yaparsak nasıl yapabiliriz?

Rica ederim.
Sanırım dizi formülü gibi bir şeyler kullanmak gerekiyor. Bu konuda ben yardımcı olamayacağım. Formüllerle oyun hamuru gibi oynayan formül cambazı arkadaşlar var. Bu konuyu onlara havale etmek en uygunu olur.
Saygılar.

 

[Ömer]

Merhaba,

Formüllerde benden olsun.

E1;

=EĞERSAY(Sayfa1!A:A;A1)

C3;

=EĞER(SATIR(A1)>$E$1;"";İNDİS(Sayfa1!B$1:B$100;KÜÇÜK(EĞER(Sayfa1!$A$2:$A$100=$A$1;SATIR($A$2:$A$100));SATIR(A1))))

Dizi formülüdür. C3 hücresindeki formülü yana ve alt hücrelere kopyalayabilirsiniz..

Yalnız sayfa sayısı ve veri sayısı fazla ise dosya boyutu büyüyecektir. Bu yüzden Sayın leumruk' un yazdığı kodları kullanmanız daha mantıklıdır..

Ayrıca bu işlemleri tüm sayfaları seçerek ( Sayfa1 hariç ) tek bir sayfadan yaparsanız formüller diğer sayfalarada aktarılır..

.

 

[boztepelibey]

espiyonajl ÜSTAD;

Allah Şahidim olsun leumruk üstadımdan sonra aklımdan siz geçtiniz.

Yardımınızı esirgemediğiniz için TEŞEKKÜR EDERİM.

Allah yar ve yardımcınız olsun

 

[Ömer]

Sayın boztepelibey, ben teşekkür ederim.

Allah sizinde yar ve yardımcınız olsun.

Saygılarımla..

Ömer

 

[turkuaz81]

Merhaba,

Sub Aktar()
Set S1 = Sheets("Sayfa1")
For Syf = 2 To Sheets.Count
    For x = 2 To S1.[a65536].End(3).Row
        If Sheets(Syf).[a1] = Cells(x, "a") Then
            Sat = Sheets(Syf).[c65536].End(3).Row + 1
            Sheets(Syf).Cells(Sat, "c") = S1.Cells(x, "b")
            Sheets(Syf).Cells(Sat, "d") = S1.Cells(x, "c")
        End If
    Next
Next
End Sub

Üstadım hazırladığın makroda şöyle bir hata var;

Butona her tıklandığında aynı döngüyü aktarıyor.Tekrarlamaları nasıl engelleyebiliriz?

 

[leumruk]

Üstadım hazırladığın makroda şöyle bir hata var;

Butona her tıklandığında aynı döngüyü aktarıyor.Tekrarlamaları nasıl engelleyebiliriz?

Merhaba,
Kodu ve dosyayı güncelledim. Yeniden indirebilirsiniz.

 

[turkuaz81]

İşte bu, eline sağlık..

 

[leumruk]

İşte bu, eline sağlık..

Rica ederim.