Farklı Elemanlardan Sıralı Veri Alma

[askm]

Kolay gelsin. Ekteki örnekte açıklamaya çalıştım. Mevcut sayfasında sütunlarda veriler mevut. A sütunundaki ürünlerden her birinden birer kere alacak. Sonra altına tekrar aynı üründen bir daha alacak. Ürün bitti ise o ürün atlanacak aynı sıra ile tüm ürünler bitene kadar devam edecek. Mantığını kuramadım malesef. Yardımcı sayfa kullanarak her ürün adı için bir sütuna alacak şekilde yapılabilir ama yanındaki bilgiler kalıyor.
Yardımcı olacak arkadaşlara şimdiden teşekkürler.

 

[tamer42]

Kolay gelsin. Ekteki örnekte açıklamaya çalıştım. Mevcut sayfasında sütunlarda veriler mevut. A sütunundaki ürünlerden her birinden birer kere alacak. Sonra altına tekrar aynı üründen bir daha alacak. Ürün bitti ise o ürün atlanacak aynı sıra ile tüm ürünler bitene kadar devam edecek. Mantığını kuramadım malesef. Yardımcı sayfa kullanarak her ürün adı için bir sütuna alacak şekilde yapılabilir ama yanındaki bilgiler kalıyor.
Yardımcı olacak arkadaşlara şimdiden teşekkürler.

Ekli dosyayı kontrol eder misiniz,
umarım işinizi görür.....

 

[askm]

Tamer Bey ilginiz için teşekkürler. sh2 H sütununa verileri öncelikle benzersiz olarak almak gerekli. Siz sanırım manuel yazdınız. Aşağıdaki şekilde revize edince oldu.
İlginiz için tekrar teşekkürler.

Sub VeriAktar()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim i As Long, j As Long, k As Long
Dim Son As Long, a As Long
Dim m As String
Dim benzersizSon As Long

Set sh1 = Sheets("Mevcut")
Set sh2 = Sheets("Olması Gereken")

sh2.Range("H1:H65536").ClearContents
sh1.Range("E2:E100").ClearContents
sh2.Range("A2:C100").ClearContents

sh1.Range("A1:a" & sh1.Range("a65536").End(3).Row).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
sh1.Range("A1:a" & sh1.Range("a65536").End(3).Row).Copy sh2.Range("h1")
sh1.ShowAllData

benzersizSon = sh2.Cells(sh1.Rows.Count, "H").End(xlUp).Row
a = 2

Son = sh1.Cells(sh1.Rows.Count, "A").End(xlUp).Row

sh2.Select

For j = 1 To benzersizSon

For k = 2 To benzersizSon

 m = sh2.Cells(k, 8)

        For i = 2 To Son

        If (sh1.Cells(i, 1) Like m And sh1.Cells(i, 5) Like "") Then

            sh1.Cells(i, 5) = "X"
            
            sh2.Cells(a, 1) = sh1.Cells(i, 1)
            sh2.Cells(a, 2) = sh1.Cells(i, 2)
            sh2.Cells(a, 3) = sh1.Cells(i, 3)
            
           a = a + 1
     GoTo 20

        End If

        Next i

20:

Next k

Next j

End Sub

 

[tamer42]

Tamer Bey ilginiz için teşekkürler. sh2 H sütununa verileri öncelikle benzersiz olarak almak gerekli. Siz sanırım manuel yazdınız. Aşağıdaki şekilde revize edince oldu.
İlginiz için tekrar teşekkürler.

önemli olan işinizi görmesi;

iyi çalışmalar.