Sayfa Adı Getirme

[bilgisayarji]

benim yaklaşık 200 sayfalık bir sayfam var
A sayfası Ana Sayfa olarak kullanıyorum H3 Fİrma Adı
diğer Sayfalar 1 2 3 4 5 6 7 .... diye gidiyor tüm sayfaların D2 hücresinde yazan firma adını ANA SAYFA H3 satırana alt alta getire bilirmyim ?

ben makro kaydederek aşağıdaki gibi bir kod ürettim fakat daha kolay bir yöntemi var mıdır ?


Range("H3").Select
ActiveCell.FormulaR1C1 = "='1'!R[-1]C[-4]"
Range("H4").Select
ActiveCell.FormulaR1C1 = "='2'!R[-2]C[-4]"
Range("H5").Select
ActiveCell.FormulaR1C1 = "='3'!R[-3]C[-4]"
Range("H6").Select
ActiveCell.FormulaR1C1 = "='4'!R[-4]C[-4]"
Range("H7").Select
ActiveCell.FormulaR1C1 = "='5'!R[-5]C[-4]"
Range("H8").Select
ActiveCell.FormulaR1C1 = "='6'!R[-6]C[-4]"
Range("H9").Select
ActiveCell.FormulaR1C1 = "='7'!R[-7]C[-4]"

 

[Korhan Ayhan]

Deneyiniz.

H3 hücresine uygulayıp alta doğru sürükleyiniz.

=EĞERHATA(DOLAYLI("'"&SATIR(A1)&"'!D2");"")

 

[bilgisayarji]

=EĞERHATA(DOLAYLI("'"&SATIR(A1)&"'!D2");"")
ilerde kullananlar hata yaparsa geri gelsin diye marko oluşturmak istersem marko kaydetten yapmam yeterli olur sanırım

 

[Korhan Ayhan]

Döngü ile firma isimlerini listeleyebilirsiniz.

Option Explicit

Sub Firma_Adi_Listele()
    Dim Sayfa As Worksheet, Satir As Long
    
    Satir = 3
    
    For Each Sayfa In ThisWorkbook.Worksheets
        If Sayfa.Name <> "A" Then
            Sheets("A").Cells(Satir, "H") = Sayfa.Range("D2").Value
            Satir = Satir + 1
        End If
    Next
    
    MsgBox "Firma adları listelenmiştir.", vbInformation
End Sub

 

[bilgisayarji]

hocam
=EĞERHATA(DOLAYLI("'"&SATIR(A1)&"'!D2");"")
bu formul sıkıntısız calıstı


Fakat aşağıdaki sıkıntı çıkarttı nedenini çözemedim
birinci sayfanın ismi H8cıktı ama üsteki işimi gördü şimdilik teşekkür ederim


Option Explicit

Sub Firma_Adi_Listele()
Dim Sayfa As Worksheet, Satir As Long

Satir = 3

For Each Sayfa In ThisWorkbook.Worksheets
If Sayfa.Name <> "A" Then
Sheets("A").Cells(Satir, "H") = Sayfa.Range("D2").Value
Satir = Satir + 1
End If
Next

MsgBox "Firma adları listelenmiştir.", vbInformation
End Sub

 

[Korhan Ayhan]

Siz mesajınızda "A" sayfası diye belirtmiştiniz. Bu sebeple bende kod içinde "A" olarak belirttim.

Dosyanızda bize bildirmediğiniz başka detay yoksa aşağıdaki kodun sorun çıkarmadan çalışması gerekir.

Option Explicit

Sub Firma_Adi_Listele()
    Dim Sayfa As Worksheet, Satir As Long
   
    Satir = 3
   
    For Each Sayfa In ThisWorkbook.Worksheets
        If Sayfa.Name <> "H8cıktı" Then
            Sheets("H8cıktı").Cells(Satir, "H") = Sayfa.Range("D2").Value
            Satir = Satir + 1
        End If
    Next
   
    MsgBox "Firma adları listelenmiştir.", vbInformation
End Sub

 

[bilgisayarji]

Option Explicit

Sub Firma_Adi_Listele()
Dim Sayfa As Worksheet, Satir As Long

Satir = 3

For Each Sayfa In ThisWorkbook.Worksheets
If Sayfa.Name <> "H8cıktı" Then
Sheets("H8cıktı").Cells(Satir, "H") = Sayfa.Range("D2").Value
Satir = Satir + 1
End If
Next

MsgBox "Firma adları listelenmiştir.", vbInformation
End Sub


Sheets("H8cıktı").Cells(Satir, "H") = Sayfa.Range("D2").Value
burası için hata verdi hocam

 

[bilgisayarji]

Option Explicit

Sub Firma_Adi_Listele()
Dim Sayfa As Worksheet, Satir As Long

Satir = 1

For Each Sayfa In ThisWorkbook.Worksheets
If Sayfa.Name <> "A" Then
Sheets("A").Cells(Satir, "H") = Sayfa.Range("D2").Value
Satir = Satir + 1
End If
Next

MsgBox "Firma adları listelenmiştir.", vbInformation
End Sub

bu şekilde düzelttim ilk firma adı H6 cıktı ıkı sıra yukseldi

 

[bilgisayarji]

A1 ile H8 Arasında veriler var hocam onu belirtmedim ama orda bütün firmaların bakiyelerini gösteren bir tablom var
G3 = Firma No
H3 = Firma Adı
I3= BAKİYE USD ( firma isimlerini getirdiğim gibi getiriyorum )
J3 = Bakiye TL ( firma isimlerini getirdiğim gibi getiriyorum )

A3 ile G3 arasında Toplam USD bakiyeyi Gösteren bir tablom var
çok uzun ve detaylı olmasın diye yazmamıştım

 

[Korhan Ayhan]

Örnek dosya paylaşınız.

 

[bilgisayarji]

ORNEK_DOSYA.xlsm dosyasını indir - download

ORNEK_DOSYA.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s4.dosya.tc

buyrun hocam kendimce bir şeyler yaptım

 

[Korhan Ayhan]

Firma isimleri "A" isimli sayfaya listelenecek değil mi?

 

[bilgisayarji]

doğrudur hocam A sayası ana sayfamız
firma isimlerini oraya getirince aynı kodla degısıklık yaparak bakiyeleride getirmeye calısacagım böylece öğrenmişte olacagım

 

[Korhan Ayhan]

Siz dosyanıza sanırım başka sayfalarda ekleyeceksiniz. Bu sebeple aşağıdaki yapı size daha uygun görünüyor.

200 sayfalık tablo olduğu için o şekilde düzenledim. Fakat dosyanızda 250 firma sayfası var. Siz kendinize göre kodu düzenlersiniz.

Option Explicit

Sub Firma_Adi_Listele()
    Dim X As Integer, Sayfa As Worksheet, Satir As Long
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    Satir = 3
   
    For X = 1 To 200
        On Error Resume Next
        Set Sayfa = Nothing
        Set Sayfa = Sheets(CStr(X))
        On Error GoTo 0
        
        If Not Sayfa Is Nothing Then
            Sheets("A").Cells(Satir, "H") = Sayfa.Range("D2").Value
            Satir = Satir + 1
        End If
    Next
   
    Set Sayfa = Nothing
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
   
    MsgBox "Firma adları listelenmiştir.", vbInformation
End Sub

 

[bilgisayarji]

teşekkür ederim hocam