Veri Seçimi

[gurkaan]

Sayfa 1 de ürünler alt alta sıralanıyor. Ürün sayısı yaklaşık 2,000 adet. Bu ürünlerin bazılarının, standart bazı özelliklerini başka sayfada da kullanmam gerekiyor. Bu Sayfadaki bilgileri elle giriyorum ancak Aktar sayfasında elle yazmak yada kopyalamak çok vaktimi alıyor. Seçim diye bir sütun oluşturdum , buraya yazacağım herhangi bir karakter ile ürünlerin stnadart bazı özelliklerini diğer sayfaya taşıyabilirmiyim.

Konuyu tam anlatamamış olabilirim ancak eklediğim dosyada daha iyi anlaşılmakta.

 

[gurkaan]

Bu konuyla ilgilenecek bir arkadaş yokmu acaba? Benim için çok önemlide işimi inanılmaz kolaylaştıracak. Şimdiden teşekkürler!!!

 

[Ömer]

Bu konuyla ilgilenecek bir arkadaş yokmu acaba? Benim için çok önemlide işimi inanılmaz kolaylaştıracak. Şimdiden teşekkürler!!!

Merhaba,

Module kopyalayıp çalıştırınız.

Sub Bul_Aktar()
 
    Dim c As Range, Adr As Variant, sat As Long, sut As Byte
    Dim Sv As Worksheet, Veri_Say As Long, i As Integer, say As Long
 
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
 
    Set Sv = Sheets("Veri")
 
    For i = Worksheets.Count To 1 Step -1
        With Sheets(i)
            If Not .Name = "Veri" And Not .Name = "Aktar" Then
                .Delete
            End If
        End With
    Next i
 
    Veri_Say = WorksheetFunction.CountIf(Sv.Range("J6:J" & Rows.Count), "x")
 
    Sheets("Aktar").Select
    Range("C7:F16,I7:L16").ClearContents
 
    If Veri_Say = 0 Then Exit Sub
 
    sat = 7: sut = 3
    With Sv.Range("J6:J" & Rows.Count)
        Set c = .Find("x", , , xlWhole)
        If Not c Is Nothing Then
          Adr = c.Address
            Do
 
            say = say + 1
 
            If (say - 1) Mod 20 = 0 And say <> 1 Then
                Sheets("Aktar").Copy After:=Sheets(Worksheets.Count)
                Range("C7:F16,I7:L16").ClearContents
                sut = 3
            End If
 
            Cells(sat, sut + 0) = Sv.Cells(c.Row, "C")
            Cells(sat, sut + 1) = Sv.Cells(c.Row, "D")
            Cells(sat, sut + 2) = Sv.Cells(c.Row, "F")
            Cells(sat, sut + 3) = Sv.Cells(c.Row, "H")
            sat = sat + 1
 
            If sat Mod 17 = 0 Then sat = 7: sut = 9
 
            Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With
 
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
 
    Set Sv = Nothing: Set c = Nothing
    MsgBox "Aktarma Tamam", , "excel.web.tr"
 
End Sub

.

 

[gurkaan]

Ömer bey ilginiz için tşk ederim ancak sayfa içi formülle yapabilirmiyiz.

 

[Ömer]

Sayın gurkaan,

Bu tür önemli açıklamaları mesajın sonunda değilde başında söylerseniz yaz boz yapmadan konuya dire yanıt veririz ve boşa zaman kaybını önlemiş olursunuz.

Ayırca sizin soru formüle değil makro ya uygun bir konudur. Nedeni ise veri çokluğuna göre yeni sayfa açmayı kod kendi yapmaktadır. Eğer sizi sayfaların tümünü açıp her sayfaya formül yazarsanız dosyada çalışamayacak kadar kasılmalar olur.

Yinede ben formül ile yapmak istiyorum derseniz tercih sizin. Bir sayfasını hazırlarım gerisini siz dosyanıza uyarlarsınız.

.

 

[gurkaan]

Durumu baştan belirtmek aklıma gelmedi bu konudan dolayı kusura bakmayın, yardımlardan dolayı da tşk ederim.

 

[gurkaan]

Ömer bey unutmadınız beni inş.