Satırda Bulup Sütuna Yerleştirme

[Harun_Y]

Merhaba arkadaşlar.
2 çalışma sayfası var. ana çalışma sayfasında 60 a kadar sütun var diğer data çalışma sayfasından her satırda bu 60 a kadar olan kodlar var. Yapmak istediğim satırda adı geçen kodu bulup data çalışma sütununda ilgili kodun altına satır olarak yapıştırması (kaç tane var demek istemiyorum hangi satırda varsa onun altına atsın yoksa olamayan kod u boş bıraksın)
Dosya ektedir yardımcı olursanız sevinirim.

 

[ÖmerBey]

Merhaba,
Data sayfası A1:N50 aralığını seçip, sağ tıkla kopyala diyiniz.
Ana Liste sayfasına gidip A2 hücresinde sağ tıklayınız ve özel yapıştır dedikten sonra açılan pencerenin sağ-alt tarafında yer alan işlemi tersine çevir seçeneğine tik atıp tamam dedikten sonra istediğiniz olacaktır.
İyi çalışmalar...

 

[Harun_Y]

Ömer bey cevabınız için teşekkürler lakin data dosyasıyla ana listenin sütun sayısı eşit değil yani data dosyasında 60 sütunda da veri yok bazı satırda tek bazı satırda 10 veri var sizin dediğinizi yaparsam 1 in altına 20 de gelir 50 de.

 

[ÖmerBey]

Anlaşılan ne istediğinizi tam anlamamışım.
Ana liste sayfasının nasıl olmasını istediğinizi gösteren birkaç örnek yerleştirmeyi dosya üzerinde gösterir misiniz?

 

[Harun_Y]

Anlaşılan ne istediğinizi tam anlamamışım.
Ana liste sayfasının nasıl olmasını istediğinizi gösteren birkaç örnek yerleştirmeyi dosya üzerinde gösterir misiniz?

Buyrun Hocam

 

[ÖmerBey]

Ana Liste sayfası A2 hücresine aşağıdaki formülü kopyalayıp sağa ve aşağı çekerek çoğaltınız.

=EĞER(EĞERSAY(DATA!2:2;A$1)>0;A$1;"")

 

[Orion1]

Buyurun.

Sub aktar_59()
Dim sonsat1 As Long, sonsat2 As Long, sonsut1 As Long, sonsut2 As Long
Dim i As Long, sh As Worksheet, k As Range, j As Long
Set sh = Sheets("ANA LİSTE")
Sheets("DATA").Select
sh.Range("A2:XFD" & Rows.Count).ClearContents
Application.ScreenUpdating = False
sonsut2 = sh.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To 100
    sonsut1 = Cells(i, Columns.Count).End(xlToLeft).Column
    For j = 1 To sonsut1
        Set k = sh.Range("A1:XFD1").Find(Cells(i, j).Value, , xlValues, xlWhole)
        If Not k Is Nothing Then
            sonsat2 = sh.Cells(Rows.Count, k.Column).End(xlUp).Row + 1
            sh.Cells(sonsat2, k.Column).Value = Cells(i, j).Value
        End If
    Next j
Next i
Application.ScreenUpdating = False
sh.Select
MsgBox "İşlem bitti."
End Sub

 

[Harun_Y]

Ömer bey ve Orian 1 emeğiniz için çok teşekkür ederim

 

[Orion1]

Ömer bey ve Orian 1 emeğiniz için çok teşekkür ederim

Rica ederim.
İyi çalışmalar.