Listeyi sayfalara dağıtma

[muhkem_]

merhaba,
Ekte bir tablom var. b sütununda cari kodları, c sütununda ünvanları var.
macro yu çalıştırdığımda bu listedeki bilgileri aynı dosya içinde açtığım sayfa1,2,3,4,5 in b2 ve b3 üne yazsın. Bu konuda yardımcı olursanız sevinirim.

Teşekkürler

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

[vb:1:484444ec4d]Sub kaydet()
Set s1 = Sheets("Ana liste")
For a = 2 To 11
Sheets("sayfa" & a - 1).[b2] = s1.Cells(a, 2).Value
Sheets("sayfa" & a - 1).[b3] = s1.Cells(a, 3).Value
Next
End Sub[/vb:1:484444ec4d]

 

[muhkem_]

teşekkür ederim. kullandım kodu.
yalnız sheet adları sayfa1,2,3 değilde a,b,f gibi değişken olduğunda da çalışsa ?
Sanırım burda bir düzeltme gerekecek

 

[bono]

benim aklıma bir fikir geliyor. data dosyanda hangi sheet isminde yer almasını istiyorsan onu A hücresine yazsan ve makro otomatik olarak bu sheet i açsa ve ismini A hücresinde yazan isim olarak verse işine yarayabilirmi? Eğer mevcut sheetlerin varsa ve onlarda başka bilgiler varda altına ilave bilgi göndermek istiyorsan aşağıdaki kod işine yaramayabilir.

Sub sayfaekle()
Application.ScreenUpdating = False
Set s1 = Sheets("Sheet1")
For A = 2 To s1.Cells(65536, 1).End(xlUp).Row
If WorksheetFunction.CountIf(s1.Range("A2:A" & A), s1.Cells(A, 1).Value) = 1 Then
Sheets.Add.Move After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = s1.Cells(A, 1).Value
s1.Cells.Copy
Sheets(Sheets.Count).Cells.PasteSpecial Paste:=xlFormats
Sheets(Sheets.Count).Cells.Interior.ColorIndex = xlNone
s1.Rows(1).Copy
Sheets(Sheets.Count).[a1].PasteSpecial
s1.Rows(A).Copy
Sheets(s1.Cells(A, 1).Value).Select
Sheets(s1.Cells(A, 1).Value).Rows(2).PasteSpecial
NoF = Range("A65536").Cells.End(xlUp).Row
Rows(NoF + 1 & ":65536").Select
Selection.Delete Shift:=xlUp
GoTo 10
End If
s1.Rows(A).Copy
Sheets(s1.Cells(A, 1).Value).Select
say = WorksheetFunction.CountA(Sheets(s1.Cells(A, 1).Value).Columns(1)) + 1
Sheets(s1.Cells(A, 1).Value).Rows(say).PasteSpecial
10 Next
For A = 2 To Sheets.Count
For b = A + 1 To Sheets.Count
If Sheets(b).Name > Sheets(A).Name Then GoTo 20
Sheets(b).Move before:=Sheets(A)
20 Next
Next
Sheets(1).Select
End Sub

 

[muhkem_]

Güzel olur-du- yani tek tek sheet açmazdan önce.
Ama güzel bir proje. Ben A sütununa alt alta 5 tane isim yazdım ve kodu çalıştırdım. Ama hiç bir şey olmadı . hata da vermedi ??

 

[bono]

mevcut sheetlerinden sonra (sheet2 ve sheet3den) a kolonunda yazdığınız şeyleri sheet ismi vererek açmış olması lazım. ben tekrar denedim çalışıyor. tabi size tavsiyem 1.satırı başlıklar için kullanın. Çünkü makro 1.satırı tüm sheetlere taşıyor. a2 den itibaren başlayan bilgileri ise a kolonunda yazan şeylere göre sınıflandırıyor.

Ben bir dosya hazırlayıp gönderiyorum ekte. bir deneyin bakalım

 

[muhkem_]

Evet elinize sağlık.
isimleri bulunduğu sheet e sheet1 adını vermemişim.

 

[bono]

rica ederim

 

[bono]

bu arada bu kod.da bana yardımcı olan leventm ye teşekkür etmek lazım..