Veri Seçimi

Katılım
8 Aralık 2010
Mesajlar
17
Excel Vers. ve Dili
2007 / TÜRKÇE
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.
 

Ekli dosyalar

Katılım
8 Aralık 2010
Mesajlar
17
Excel Vers. ve Dili
2007 / TÜRKÇE
Bu konuyla ilgilenecek bir arkadaş yokmu acaba? Benim için çok önemlide işimi inanılmaz kolaylaştıracak. Şimdiden teşekkürler!!!
 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
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.

Kod:
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
.
 
Katılım
8 Aralık 2010
Mesajlar
17
Excel Vers. ve Dili
2007 / TÜRKÇE
Ömer bey ilginiz için tşk ederim ancak sayfa içi formülle yapabilirmiyiz.
 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
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.

.
 
Katılım
8 Aralık 2010
Mesajlar
17
Excel Vers. ve Dili
2007 / TÜRKÇE
Durumu baştan belirtmek aklıma gelmedi bu konudan dolayı kusura bakmayın, yardımlardan dolayı da tşk ederim.
 
Katılım
8 Aralık 2010
Mesajlar
17
Excel Vers. ve Dili
2007 / TÜRKÇE
Ömer bey unutmadınız beni inş.
 
Üst