EXCEL sayfalarından bir verinin icmalini çıkarma

[alpayelmas]

Arkadaşlar merhaba;
bir excel makro kitabı aldım ama bir türlü ihtiyaclarımı yazabılecek sevıyeye gelemıyorum. acıl olarak assagıdakı rutını yapabılecek bır kod ıhtıyacım var.

excel kitabımda sayısı değişken miktarda sayfalarım var. oluşturduğum ICMAL sayfasının içinde bir butona basarak excel kitabımda kaç tane sayfa var ise hepsindeki a1 hucresindeki yazıyı e1 hucresındeki yazı ile aralarına bir bosluk ekleyerek birleştirip ICMAL sayfasında A sütunu 2. satıra yazarak aynı sayfadakı ÇAP yazısı altındaki değer Ø8 ise B2. sutuna Ø10 ise C2. sutuna Ø12 ise D2.sutuna Ø14 ise E2. sütuna.16-18-20-22-24-26-28-30- ve Ø32 ise N2. sütüna yazan. ve ÇAP altındaki değerler bittiğinde icmalde bir alt satıra diğer bir sayfa içinde aynı rutını uygulayıp tum sayfaların bu sekılde ıcmalını alabılen bır koda ıhtıyacım var .
Yardımcı olabılecek arkadaşlarıma şimdiden teşekkür ederim.
Selamlar.

 

[Ömer BARAN]

Merhaba.

Cevabımın altındaki açıklamaları okuyup;
sorunuzu bir örnek belge ile desteklerseniz
daha hızlı ve net cevap alacağınızı düşünüyorum.

 

[alpayelmas]

Merhaba;
hızlı geri dönüşünüz için teşekkür ederim.
aşağıdaki linkte örnek dosyamı yukledim. örnek excel imdeki sayfalarda inşaat demir metraj tablolarım var. Icmal ismindeki sayfada da icmal formum var. ICMAL sayfasına bir buton ekleyip tıkladığımda sayfa sayısını bulup tum sayfalardan a1 hucresindeki yazıyı e1 hucresındeki yazı ile aralarına bir bosluk ekleyerek birleştirip Icmal de ilk sutuna yazıp yanındaki hucrelere CAP yazısı altındaki demir çaplarına göre toplam ağırlık sayısal değerleri İcmal sayfasına yazdırmak istiyorum
tekrar teşekkür ederim..

https://yadi.sk/d/yOQXxugrr3TPB

 

[asi_kral]

Merhaba
Boş bir module kopyalayın ve deneyin.

Sub getir()
Dim SYF As Worksheet, SYF1 As Long, STR As Long
Dim STN As Long, STR1 As Long, ANA As Worksheet
Application.ScreenUpdating = False
Set ANA = Sheets("İCMAL")
ANA.Range("A2:N" & Rows.Count).ClearContents
STR = 2
For SYF1 = 1 To Sheets.Count
Set SYF = Sheets(SYF1)
If SYF.Name <> "İCMAL" Then
ANA.Cells(STR, "A") = SYF.Range("A1")
For STR1 = 3 To SYF.Range("D" & Rows.Count).End(xlUp).Row
STN = WorksheetFunction.Match(SYF.Range("D" & STR1), ANA.Range("A1:N1"), 0)
ANA.Cells(STR, STN) = SYF.Range("J" & STR1)
Next
STR = STR + 1
End If
Next
Application.ScreenUpdating = True
End Sub

 

[alpayelmas]

Çok teşekkür ederim. Çok sağolun.
Direk istediğim olmuş.

 

[asi_kral]

Çok teşekkür ederim. Çok sağolun.
Direk istediğim olmuş.

Kolay Gelsin.