Verileri sayfalara dağıtmak

[önder34]

Merhaba arkdaşlar sıra no adı soyadı ve şube bilgileri olan 200 satırlık sayfadaki bilgileri şube bilgileri bölümünü girince şube adı yazan sayfalara isimleri ve soyadları aktar butonu koyarak nası aktarabiliriz. Yardımcı olabilecek birisi varsa sevinirim

 

[Ömer]

Merhaba,

Module kopyalayarak çalıştırınız. Yalnız D sütunundaki değer adında sayfa adı olmazsa hata alırsınız. Veri düzeninin bu şekilde olma ihtimali varsa kodları ona göre değiştirmek gerekir. Bu yönde bilgi verirseniz yeniden düzenleme yaparım..

Option Explicit
 
Sub Sayfalara_Dağıt()
Dim Sayfa As Variant, i As Long, son As Long, S1 As Worksheet
Set S1 = Sheets("Sayfa6")
    For i = 1 To Worksheets.Count
        If Sheets(i).Name <> "Sayfa6" Then
            Sheets(i).Range("A3:C65536").ClearContents
        End If
    Next i
 
    For i = 3 To S1.[D65536].End(3).Row
        Sayfa = S1.Cells(i, "D")
        son = Sheets(Sayfa).[B65536].End(3).Row + 1
        Sheets(Sayfa).Cells(son, "A") = son - 2
        S1.Range("B" & i & ":C" & i).Copy Sheets(Sayfa).Cells(son, "B")
    Next i
 
MsgBox "Akatarım tamamlandı."
End Sub

.

 

[önder34]

MRB

Sayın Ömer bey ben düzenleme yapamadım butona aktarma olayı nasıl olacak .Ve ayrıca her sayfada mı d sütununda bilgi olması gerekiyor .Ben sadece isim olan sayfalarda d sütununa şube isimlerini yazarak aktar butonuna bastığımda şube ismi yazılı olan sayfalara verileri aktarmak istiyorum .Konu ile yeniden ilgilenebilirseniz memnun olurum

 

[önder34]

arkadaşlar sorunumla ilgili cevap verebilecek kimse yok mu sabahtan beri denemediğim yol kalmadı yapmadım bir türlü makroyu atayamadım lütfen yardım bekliyorum

 

[Ömer]

Eki inceleyiniz..

.

 

[önder34]

Sayın Ömer bey istedğim gibi olmuş emeğinize ve ilginize teşekkür ederim . Ben neden makroyu atayamadım onu bulmaya çalışıyorum

 

[rhurriyet]

Selam arkadaşlar. 10 günlük arayışımın sonunda aradığımı buldum fakat dün akşamdan beri uyku bile uyumadan üzerinde çalışmama rağmen kodları kendi sistemime adapte edemedim. Yapmak istediğim şey: KASA sayfasındaki "A"ve"J" sutunları arasındaki verileri; 1 Ocak dan 10 Şubata kadar Ocak sayfasına, 10 Şubattan 10 Marta kadar Mart sayfasına ve bundan sonraki verileri aynı düzende gerekli sayfalara göndermek istiyorum (Asıl veriler KASA sayfasında kalacak) Yardımcı olursanız çok sevinirim.

 

[Ömer]

Merhaba,

Bu şekilde deneyiniz..

Option Explicit
 
Sub Sayfalara_Dağıt()
Dim Sayfa As Variant, i As Long, son As Long
Sheets("KASA").Select
    For i = 1 To Worksheets.Count
        If Sheets(i).Name <> "KASA" And Sheets(i).Name <> "index" Then
            Sheets(i).Range("A3:J65536").ClearContents
        End If
    Next i
 
    For i = 2 To [B65536].End(3).Row
        Sayfa = Format(Cells(i, "B"), "mmmm")
        If Sheets(Sayfa).Range("A3") = "" Then
            son = 3
        Else
            son = Sheets(Sayfa).[A65536].End(3).Row + 1
        End If
        Sheets(Sayfa).Cells(son, "A") = son - 2
        Range("B" & i & ":J" & i).Copy Sheets(Sayfa).Cells(son, "B")
    Next i
 
MsgBox "Akatarım tamamlandı."
End Sub

.

 

[rhurriyet]

Çok teşekkür ederim Ömer uzmanım. Formül çalışıyor ama ben dataları ayın 10undan 10una kadar aktarmak istiyordum bunu nasıl yapabilirim?

 

[Ömer]

Veri aralıklarını daha detaylı açıklarmısınız.

1 ocak .... 10 şubat
11 şubat mı olacak yoksa bir üsteki 9 şubat mı olacak ?

ocak - aralık arasındaki sayfaları bu şekilde tarih vererek ( başlangıç bitiş tarihlerinde aynı gün gelmeyecek şekilde,eğer aynı gün gelecekse de bunuda açıklarsınız. ) tümünü yazarmısınız..

.

 

[rhurriyet]

ekteki örnekte "O" sütununda açıklamıştım ama. Sadece ocak tam ay ve şubatın ilk 10 gününü alacak ondan sonraki bütün aylar 11'inden diğer ayın 10'una kadar.Aynı gün gelmeyecek.

 

[Ömer]

Dosyada herhangi bir açıklama yok,eğer O sütununa yazdığınız ay adlarından bahsediyorsanız oradan bakıp bir mantık yürütülebilir. Yalnız bunu açıklasaydınız dosyada görmem daha kolay olurdu.

O sütununda aktarılması gerek ay adları olacak mı yoksa siz göstermek için mi yazdınız. Eğer kalmıyacaksa aralık ayının tarih aralığı 10.12 ile 31.12 arasımı olması gerekiyor.

.

 

[rhurriyet]

"O" Sütünü sadece bilgi amaçlı yaptım aydınlatması açısından. Evet 10.12-31.12 olacak.

 

[Ömer]

Bu şekilde deneyiniz..

Option Explicit
 
Sub Sayfalara_Dağıt()
Dim Sayfa As Variant, i As Long, son As Long
Dim Aylar
Aylar = Array("", "OCAK", "ŞUBAT", "MART", "NİSAN", "MAYIS", "HAZİRAN", "TEMMUZ", "AĞUSTOS", "EYLÜL", "EKİM", "KASIM", "ARALIK")
Sheets("KASA").Select
    For i = 1 To Worksheets.Count
        If Sheets(i).Name <> "KASA" And Sheets(i).Name <> "index" Then
            Sheets(i).Range("A3:J65536").ClearContents
        End If
    Next i
 
    For i = 2 To [B65536].End(3).Row
        If Month(Cells(i, "B")) = 1 Or Day(Cells(i, "B")) > 10 Then
            Sayfa = Aylar(Month(Cells(i, "B")))
        Else
            Sayfa = Aylar(Month(Cells(i, "B")) - 1)
        End If
 
        If Sheets(Sayfa).Range("A3") = "" Then
            son = 3
        Else
            son = Sheets(Sayfa).[A65536].End(3).Row + 1
        End If
        Sheets(Sayfa).Cells(son, "A") = son - 2
        Range("B" & i & ":J" & i).Copy Sheets(Sayfa).Cells(son, "B")
    Next i
 
MsgBox "Akatarım tamamlandı."
End Sub

.

 

[rhurriyet]

Çok teşekkür ederim ellerin dert görmesin.