birçok çalışma sayfasından istenilen verileri almak

[aekturk]

Merhaba;

Bir çalışma kitabında userform ile "Cari Kart" oluşturuyorum.
a) CariKartlar isimli sayfaya formdaki verileri ekliyorum.
b) Sablon isimli bir sayfada verileri aktarıp yeni bir sayfa oluşturup sıra numarası kaçta kaldı ise o numarada bir sayfa oluşturup bilgilerini oraya yazdırıyorum ve sayfa ismine sıra numarasını verdiriyorum.

Sorum ise "Cari Liste" isimli çalışma sayfasına;
A2 hücresine 1 isimli çalışma sayfasının B1 hücresindeki veriyi "S.No"
B2 hücresine 1 isimli çalışma sayfasının B2 hücresindeki veriyi "Ünvanı"
C2 hücresine 1 isimli çalışma sayfasının E6 hücresindeki veriyi "Borç"
D2 hücresine 1 isimli çalışma sayfasının F6 hücresindeki veriyi "Alacak"
E2 hücresine 1 isimli çalışma sayfasının E5 hücresindeki veriyi "Bakiye"
F2 hücresine eğer B-A>0;"B", eğer A-B>0;"A", eğer B=A;"-" verisini "B / A"

Aynı şekilde kaç tane sayı ile başlayan çalışma sayfası var ise (örneğin 100) aynı şekilde A3,B3,C3,D3,E3,F3.... şeklinde devam etmesini istiyorum.

Yardımcı olabilecek arkadaşlara şimdiden teşekkür ederim.

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin. Ancak F sutununa veri nasıl getirilecek anlayamadım.

Sub verial()
Set s1 = Sheets("Cari Liste")
For Each sayfa In ThisWorkbook.Sheets
If IsNumeric(sayfa.Name) = True Then
Set s2 = sayfa
sat = s2.Name
s1.Cells(sat + 1, "a") = s2.[b1]
s1.Cells(sat + 1, "b") = s2.[b2]
s1.Cells(sat + 1, "c") = s2.[e6]
s1.Cells(sat + 1, "d") = s2.[f6]
s1.Cells(sat + 1, "e") = s2.[e5]
s1.Cells(sat + 1, "f") = ??????
End If
Next
End Sub

 

[aekturk]

Levent Bey, teşekkür ederim. az önce bende istediğim şeyi yaptım. fakat saçlarım beyazladı
Allah sizden razı olsun benim yazdığım kodlar da şu şekilde


Private Sub CommandButton4_Click()
On Error Resume Next
Unload UserForm3
Sheets("Cari Liste").Select
Range("A2:F500").ClearContents
Range("A2").Select
For satir = Sheets("CariKartlar").Range("A1") To Sheets("CariKartlar").Range("A500").End(3)
Range("A65536").End(3).Offset(0, 1) = Range("A65536").End(3) + 1
Range("A65536").End(3).Offset(1, 1).FormulaLocal = "=" & satir & "!B1"
Range("A65536").End(3).Offset(1, 2).FormulaLocal = "=" & satir & "!B2"
Range("A65536").End(3).Offset(1, 3).FormulaLocal = "=" & satir & "!E6"
Range("A65536").End(3).Offset(1, 4).FormulaLocal = "=" & satir & "!F6"
Range("A65536").End(3).Offset(1, 4).FormulaLocal = "=" & satir & "!E5"
Range("A65536").End(3).Offset(1, 5).FormulaLocal = "=" & satir & "!F4"
Next
Columns("A:G").Select
Range("G1").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
MsgBox "Cari Borç / Alacak listesi hazırlanmıştır"
End Sub

 

[aekturk]

hem hızlı hemde çok az kod ile bitirmişsiniz. sizin kodlarınızı kullanacağım. ilginize teşekkür ederim.