Excel de sayfalardan bir değere göre bazı hucreleri tek bir sayfada icmal oluşturma

[alpayelmas]

Arkadaşlar merhaba;
excelde makrolar konusunda çok ta iyi değilim . bir excel kitabında sayısı değişken adette sayfalar var. Bu sayfalardan 1.si Sayfa1 isminde diğerlerinin ismi farklı farklı . bu farklı sayfaların içinde sayısı belli olmayan bir satırda B ve H hücreleri birleştirilmiş olarak içindeki değeri ARATOPLAM AĞIRLIK (TON) : yazıyor. Benim yapmak istediğim. bu ARATOPLAM AĞIRLIK (TON) : yazan satırı tespit edip Sayfa birde 1. satırdan itibaren her farklı sayfanın adını A sutununa ve sayfalardaki ARATOPLAM AĞIRLIK (TON) : satırının yanında bulunan I dan W ya kadar hucrelerdeki değerleride Sayfa1 deki B sutunundan ıtıbaren yıne yan yana yazması boylelıkle olusan sıralama neticede Sayfanın adı, I,J...W alt satırda yine Sayfanın adı , I,I....W gibi her farklı sayfa ıcın Sayfa1 in içine bir icmal oluşturması ve en sonunda sayfa1 in ismini Metraj İcmal olarak değiştirmesi.
Bunu Sayfa1 içinde bir butona tanımlayıp işlemi yaptırabilecek bir makro kodu yazabılecek brı arkadasım varmı?
Teşekkürler

 

[tahsinanarat]

Private Sub CommandButton1_Click()
Set s1 = Sheets("Sayfa1")
son = s1.Range("a65536").End(3).Row + 1
For syf = 2 To Sheets.Count
For i = 2 To Sheets(syf).Range("B65536").End(3).Row
If "ARATOPLAM AĞIRLIK (TON) :" = Sheets(syf).Cells(i, 2) Then
s1.Cells(son, 1) = Sheets(syf).Name
s1.Cells(son, 2) = Sheets(syf).Cells(i, 9)
s1.Cells(son, 3) = Sheets(syf).Cells(i, 10)
s1.Cells(son, 4) = Sheets(syf).Cells(i, 11)
s1.Cells(son, 5) = Sheets(syf).Cells(i, 12)
s1.Cells(son, 6) = Sheets(syf).Cells(i, 13)
s1.Cells(son, 7) = Sheets(syf).Cells(i, 14)
s1.Cells(son, 8) = Sheets(syf).Cells(i, 15)
s1.Cells(son, 9) = Sheets(syf).Cells(i, 16)
s1.Cells(son, 10) = Sheets(syf).Cells(i, 17)
s1.Cells(son, 11) = Sheets(syf).Cells(i, 18)
s1.Cells(son, 12) = Sheets(syf).Cells(i, 19)
s1.Cells(son, 13) = Sheets(syf).Cells(i, 20)
s1.Cells(son, 14) = Sheets(syf).Cells(i, 21)
s1.Cells(son, 15) = Sheets(syf).Cells(i, 22)
s1.Cells(son, 16) = Sheets(syf).Cells(i, 23)
son = son + 1
End If
Next
Next
End Sub

 

[alpayelmas]

Çok teşekkürler hemen deniyorum

 

[alpayelmas]

Sadece
For syf = 2 To Sheets.Count
For i = 2 To Sheets(syf).Range("B65536").End(3).Row

satırını
For syf = 1 To Sheets.Count
For i = 1 To Sheets(syf).Range("B65536").End(3).Row

yaptım çok çok teşekkür ederim ellerinize sağlık

 

[Necdet]

Merhaba,

Konu başlığınızı lütfen sorunuzu özetleyecek şekilde değiştiriniz.

 

[alpayelmas]

tahsinanarat bey merhaba;
Bu kodu acaba değerleri almak yerine sayfalara formulle baglayacak halde yazmanız mumkunmu acaba?

 

[ÖmerBey]

Kodları şu formatta değiştirebilirsiniz.

s1.Cells(son, 2)[COLOR="Green"].Formula[/COLOR] = [COLOR="Red"]"=" & [/COLOR]Sheets(syf)[COLOR="Green"].Name[/COLOR] [COLOR="red"]& "!" &[/COLOR] Cells(i, 9)[COLOR="green"].Address[/COLOR]

 

[alpayelmas]

Merhaba;
yukarıdaki kodu uyguladım ama sonuc alamadım. sureklı sayfa sec dıye bır ekran cıkıp hucreye hatalı formul atıyor.
= NEF12-ST-PC-0-SD-304-R2-R3 SP!$I$481 makronun attıgı
=' NEF12-ST-PC-00-SD-304-R2-R3 SP'!I481 olması gereken

Duzenledıgım kod:
Set s1 = Sheets("Sayfa1")
son = s1.Range("a65536").End(3).Row + 1
For syf = 1 To Sheets.Count
For i = 1 To Sheets(syf).Range("B65536").End(3).Row
If "ARATOPLAM AĞIRLIK (TON) :" = Sheets(syf).Cells(i, 2) Then


s1.Cells(son, 1) = Sheets(syf).Name
s1.Cells(son, 2).Formula = "=" & Sheets(syf).Name & "!" & Cells(i, 9).Address
s1.Cells(son, 3).Formula = "=" & Sheets(syf).Name & "!" & Cells(i, 10).Address
s1.Cells(son, 4).Formula = "=" & Sheets(syf).Name & "!" & Cells(i, 11).Address
s1.Cells(son, 5).Formula = "=" & Sheets(syf).Name & "!" & Cells(i, 12).Address
s1.Cells(son, 6).Formula = "=" & Sheets(syf).Name & "!" & Cells(i, 13).Address
s1.Cells(son, 7).Formula = "=" & Sheets(syf).Name & "!" & Cells(i, 14).Address
s1.Cells(son, 8).Formula = "=" & Sheets(syf).Name & "!" & Cells(i, 15).Address
s1.Cells(son, 9).Formula = "=" & Sheets(syf).Name & "!" & Cells(i, 16).Address
s1.Cells(son, 10).Formula = "=" & Sheets(syf).Name & "!" & Cells(i, 17).Address
s1.Cells(son, 11).Formula = "=" & Sheets(syf).Name & "!" & Cells(i, 18).Address
s1.Cells(son, 12).Formula = "=" & Sheets(syf).Name & "!" & Cells(i, 19).Address
s1.Cells(son, 13).Formula = "=" & Sheets(syf).Name & "!" & Cells(i, 20).Address
s1.Cells(son, 14).Formula = "=" & Sheets(syf).Name & "!" & Cells(i, 21).Address
s1.Cells(son, 15).Formula = "=" & Sheets(syf).Name & "!" & Cells(i, 22).Address
s1.Cells(son, 16).Formula = "=" & Sheets(syf).Name & "!" & Cells(i, 23).Address


son = son + 1
End If
Next
Next

 

[alpayelmas]

Yardımcı olabılecekmısınız?

 

[ÖmerBey]

Şu şekilde deneyiniz.

s1.Cells(son, 2).Formula = "=[COLOR="Red"]'[/COLOR]" & Sheets(syf).Name & "[COLOR="red"]'[/COLOR]!" & [COLOR="red"]Replace([/COLOR]Cells(i, 9).Address[COLOR="red"], "$", "")[/COLOR]

İyi çalışmalar...

 

[alpayelmas]

mucit77 ne kadar teşekkür etsem az. ellerinize sağlık çok işime yaradı çok teşekkürler.