Bir sayfadaki bilgileri diğer sayfalara dağıtma

[sinekvalesi]

Merhaba,

Ekteki sayfada da göreceğiniz gibi bir sayfadaki listeyi market isimlerine göre diğer sayfalara kopyalamak istiyorum.

Bu konuda yardım edebilirseniz sevinirim.
Şimdiden teşekkür eder, iyi akşamlar dilerim.

 

[Orion1]

Kupa beyinden selamlar.,
Dosyanız ektedir.
Buyurunuz.

Sub sayfayaat_59()
Dim i As Long, sat As Long, sh As Worksheet
Dim sh2 As Worksheet
Set sh = Sheets("genel")
Application.ScreenUpdating = False
sh.Range("A1").AutoFilter
For i = 2 To Worksheets.Count
    Set sh2 = Sheets(i)
    sh.Range("A1").AutoFilter field:=1, Criteria1:=sh2.Name
    If WorksheetFunction.Subtotal(103, sh.Range("A2:A" & sh.Rows.Count)) > 0 Then
        sat = sh2.Cells(Rows.Count, "A").End(xlUp).Row + 1
        sh.Range("A1").CurrentRegion.Offset(1, 0).Copy sh2.Range("A" & sat)
        sh.Range("A1").AutoFilter
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[cems]

Üstad Orion1 'in çözümüne yaklaşamaz ama benim çözümüm de ekteki gibidir.

 

[EXTRANET]

kupa beyinden selamlar.,
dosyanız ektedir.
Buyurunuz.

sub sayfayaat_59()
dim i as long, sat as long, sh as worksheet
dim sh2 as worksheet
set sh = sheets("genel")
application.screenupdating = false
sh.range("a1").autofilter
for i = 2 to worksheets.count
    set sh2 = sheets(i)
    sh.range("a1").autofilter field:=1, criteria1:=sh2.name
    ıf worksheetfunction.subtotal(103, sh.range("a2:a" & sh.rows.count)) > 0 then
        sat = sh2.cells(rows.count, "a").end(xlup).row + 1
        sh.range("a1").currentregion.offset(1, 0).copy sh2.range("a" & sat)
        sh.range("a1").autofilter
    end ıf
next
application.screenupdating = true
msgbox "işlem tamamlandı." & vblf & "evrengizlen@hotmail.com"
end sub

üstadım

sayfa dağıtımı yaptıktan sonra dağıtımı yapılan verilen silineblir mi?

Teşeküler

 

[EXTRANET]

cevap verecek var mı?

 

[cems]

next
Sheets("genel").Activate
Range("a2:f300").Select
Selection.ClearContents
Range("a2").Select
Application.ScreenUpdating = True

Sayın Orion1'in kodlarının alt kısmına bu 4 satırı araya sokarak yerleştirip çalıştırınız.
Sayın Orion1 affınıza sığınarak kodlarınıza ek yaparak arkadaşın probleminde ilerleme yapmasına çalıştım .

 

[EXTRANET]

Ilginiz için çok teşekür ederim.

Uyguladım ama olmadı

 

[EXTRANET]

Dosya ekte

veri sayfasından dağıtım yapıyorum

yardım edermisiniz.

Teşekürler

 

[cems]

Genel diye sayfa yok onun yerine veri adlı bir sayfa var. Kodlarda şunları değiştiriniz:

Sheets("veri").Activate
Range("a2:G5300").Select
Selection.ClearContents
Range("a2").Select
Application.ScreenUpdating = True

'Next

Ayrıca başka kitaba bağlantı da var ve bunun neyi etkileyebileceğini bilmiyorum

 

[EXTRANET]

Süpersiniz

sen beni mutlu ettin allah ta seni mutlu etsin

 

[cems]

Sayın EXTRANET
Asıl emek sahibi Sayın Orion1 , ben onun kodlarına ufak bir müdahale ettim haddim olmayarak , o kadar . Konunun çözülmesi güzel, hepimiz mutluyuz kolay gelsin.

 

[EXTRANET]

üstadım bii sorun oldu

veri sayfasındaki formülleride siliyor.

 

[EXTRANET]

hücreye =İNDİS(REÇETE!C:C;KAÇINCI(C117;REÇETE!B:B;0))

formülünü uyguladuğımda hücre boş ise #YOK yazıyor. formüllü hücrenin boş görünmesi için ne yapmam gerek

teşekürler

 

[cems]

=EĞER(EHATALIYSA(B3);"";B3) ( siz B3 yerine hatanın çıktığı hücre adresini yazın)
bu formülü #YOK hatasının çıktığı ilk kareye uyarlayın ve aşağı doğru çıkabilecek hücrelere çekerek indirin.

Ancak sizin formülünüzün sonucu o hücrede #YOK çıkıyorsa o zaman formül birleştirmek ya da koşullu biçimlendirme ile #YOK çıktığında fontu beyaz göstere çevirmek gerek

 

[EXTRANET]

=indis(reçete!c:c;kaçıncı(c117;reçete!b:b;0)) formülü var hücrede
yazdığınız formülü bunun içine eklemek gerek galiba ama nasıl ,

 

[EXTRANET]

KARDEŞİM ÇOK TEŞEKÜR EDERİM HALLETTİM

Sheets("veri").Activate
Range("a2:E5300").Select
Selection.ClearContents
Range("a2").Select
Application.ScreenUpdating = True


'Next


FORMÜK G VE F SUTUNUNDA

SENİN MAKROYU E YAPTIM HALLOLU TEŞEKÜRLER

 

[cems]

Kolay Gelsin

 

[sinekvalesi]

Sayın Orion1;

Öncelikle ilginiz için teşekkür ederim. Fakat şöyle bir sorun var sanırım. Genel sayfasında bulunan bilgilere sürekli yenileri ilave olacak ve her yeni bilgi eklediğimizde tıklaya basacağız bu sebeple daha önce sayfalara dağıtılan bilgilerin aynıları tekrar tekrar ilgili sayfalara dağılmış olup mükerrer kayda sebebiyet verecektir. Bu yüzden daha önce ilgili sayfalara dağıtılan bilgilerin yeniden gitmemesi gerekiyor.

( Biraz uzun oldu sanırım, umarım derdimi anlatabilmişimdir. )

Müsayit olduğunuzda yardımcı olabilirseniz sevinirim. Teşekkürler, iyi akşamlar.

 

[Orion1]

Sayın Orion1;

Öncelikle ilginiz için teşekkür ederim. Fakat şöyle bir sorun var sanırım. Genel sayfasında bulunan bilgilere sürekli yenileri ilave olacak ve her yeni bilgi eklediğimizde tıklaya basacağız bu sebeple daha önce sayfalara dağıtılan bilgilerin aynıları tekrar tekrar ilgili sayfalara dağılmış olup mükerrer kayda sebebiyet verecektir. Bu yüzden daha önce ilgili sayfalara dağıtılan bilgilerin yeniden gitmemesi gerekiyor.

( Biraz uzun oldu sanırım, umarım derdimi anlatabilmişimdir. )

Müsayit olduğunuzda yardımcı olabilirseniz sevinirim. Teşekkürler, iyi akşamlar.

diğer sayfalara eklenen verileri genel sayfasından silecezmi?Ne yapacaz?

 

[sinekvalesi]

diğer sayfalara eklenen verileri genel sayfasından silecezmi?Ne yapacaz?

Yok hayır silinmeyecek genel sayfasında kalacak.