Belgedeki Verileri Listeleme

[mustafaatalay]

Merhabalar arkadaşlar,


Ekte bulunan dosyada yaklaşık 100 sayfa var ve bunun gibi elimde 6 farklı dosya var. Sizden yardımcı olmanızı istediğim konu bu belgedeki her sayfadan belirli verileri listelemek istiyorum eğer bu konuda yardımcı olabilirseniz çok memnun olurum.

Belgedeki her sayfadan alıp listelemek istediğim veriler şu şekildedir;

Sayfa numarası:
System name:
Mass:
Drawing No:

İlk veya sonda bir sayfa oluşturarak bunları listememde bana yardımcı olabilirseniz çok memnun olurum.

 

[ÖmerBey]

Merhaba,
Örnek dosyanız için aşağıdaki kodu deneyiniz.

Sub Kod()
Dim s1 As Worksheet, s2 As Worksheet, x As Byte, son As Byte, a As Byte
Application.ScreenUpdating = False
baslik = Array("Alınan Sayfa Adı", "Sayfa Numarası", "System Name", "Mass", "Drawing No", "Spool No", "Material")
Set s1 = Worksheets.Add(Sheets(1))
s1.Name = "Liste"
s1.Range("A1:G1").Value = baslik
x = 2
For a = 2 To Sheets.Count
    Set s2 = Sheets(a)
    s1.Cells(x, "A") = s2.Name
    s = s2.Cells(Rows.Count, "C").End(3).Row
    If s > 2 Then
        s1.Cells(x, "B") = WorksheetFunction.Trim(Split(s2.Cells(s - 1, "X"), vbLf)(1))
        s1.Cells(x, "C") = WorksheetFunction.Trim(Split(s2.Cells(s - 2, "C"), vbLf)(1))
        s1.Cells(x, "D") = WorksheetFunction.Trim(Split(s2.Cells(s, "C"), vbLf)(1))
        s1.Cells(x, "E") = WorksheetFunction.Trim(Split(s2.Cells(s, "F"), vbLf)(1))
        s1.Cells(x, "F") = WorksheetFunction.Trim(Split(s2.Cells(s - 1, "C"), vbLf)(1))
        s1.Cells(x, "G") = WorksheetFunction.Trim(s2.Cells(4, "P"))
    End If
    x = x + 1
Next
s1.Range("A:G").WrapText = False
s1.Range("A:G").Columns.AutoFit
Application.ScreenUpdating = True
MsgBox "İşlem tamam"
End Sub

 

[mustafaatalay]

Merhabalar,

Desteğiniz için teşekkür ederim. Emeğinize sağlık

 

[ÖmerBey]

Rica ederim,
İyi çalışmalar diliyorum...

 

[mustafaatalay]

Spool No ve ekteki işaretli kısmı ekleyebilir miyiz? Ben eklemeye çalıştım ama beceremedim tekrar yardımcı olabilirseniz çok memnun olurum

 

[ÖmerBey]

2 numaralı mesajdaki kodu isteğiniz doğrultusunda güncelledim.
İyi çalışmalar...

 

[mustafaatalay]

ekteki gibi bir hata alıyorum.

 

[ÖmerBey]

Önceki kod çalışmışsa bunun da çalışması gerek, kod yapısında bir değişiklik yapmadım. Farklı bir durum oluşmuş olabilir.
Mesela; kodu aynı dosyada iki kere çalıştırmışsanız iki tane "Liste" isminde sayfa olamayacağı için kod hata verecektir... gibi.

 

[mustafaatalay]

Evet liste diye sayfa olduğu için bu hatayı veriyormuş. çok teşekkür ediyorum elinize sağlık