Diğer sekmelerden veri alma

[adainsaat]

Merhabalar.. Ekte görüntüde yer aldığı üzere bir yardıma ihtiyacım var.

Benim işimde yüzlerce sekme yer aldığından makroyla kolayca halledebileceğimi düşünüyorum fakat ben beceremedim.

İlgilenebilecek arkadaşlara şimdiden teşekkür ederim.

https://hizliresim.com/u2SvDa

 

[YUSUF44]

Aşağıdaki kodları deneyiniz. Fazlası için lütfen örnek dosya paylaşınız:

Sub OZET()
Set s1 = Sheets("GENEL")
s1.Activate
eski = WorksheetFunction.Max(9, s1.Cells(Rows.Count, "G").End(3).Row)
s1.Range("G9:H" & eski).ClearContents
For i = 1 To Sheets.Count
    If Sheets(i).Name <> s1.Name Then
        yeni = s1.Cells(Rows.Count, "G").End(3).Row + 1
        s1.Cells(yeni, "G") = Sheets(i).Name
        s1.Cells(yeni, "H") = Sheets(i).[G7]
    End If
Next
End Sub

 

[Korhan Ayhan]

Alternatif;

İsimleri siz yazarsanız aşağıdaki yöntemi kullanabilirsiniz.

A2 = Ali
B2;

=DOLAYLI("'"&A2&"'!G7")

 

[adainsaat]

Aşağıdaki kodları deneyiniz. Fazlası için lütfen örnek dosya paylaşınız:

Sub OZET()
Set s1 = Sheets("GENEL")
s1.Activate
eski = WorksheetFunction.Max(9, s1.Cells(Rows.Count, "G").End(3).Row)
s1.Range("G9:H" & eski).ClearContents
For i = 1 To Sheets.Count
    If Sheets(i).Name <> s1.Name Then
        yeni = s1.Cells(Rows.Count, "G").End(3).Row + 1
        s1.Cells(yeni, "G") = Sheets(i).Name
        s1.Cells(yeni, "H") = Sheets(i).[G7]
    End If
Next
End Sub

Hocam tam anlatamamışım galiba. Örnek doya linkini gönderiyorum. İlginiz için teşekkür ederim.

İndir Örnek Dosya

Dosyayı indir Örnek Dosya

dosya.co

 

[YUSUF44]

Ben kodları ilk mesajda paylaştığınız görüntüye göre G9'dan itibaren olarak şekilde yazmıştım. dosyanıza göre olması gereken kod şu şekilde:

Sub OZET()
Set s1 = Sheets("GENEL")
s1.Activate
eski = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)
s1.Range("A2:B" & eski).ClearContents
For i = 1 To Sheets.Count
    If Sheets(i).Name <> s1.Name Then
        yeni = s1.Cells(Rows.Count, "A").End(3).Row + 1
        s1.Cells(yeni, "A") = Sheets(i).Name
        s1.Cells(yeni, "B") = Sheets(i).[G7]
    End If
Next
End Sub

 

[adainsaat]

Ben kodları ilk mesajda paylaştığınız görüntüye göre G9'dan itibaren olarak şekilde yazmıştım. dosyanıza göre olması gereken kod şu şekilde:

Sub OZET()
Set s1 = Sheets("GENEL")
s1.Activate
eski = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)
s1.Range("A2:B" & eski).ClearContents
For i = 1 To Sheets.Count
    If Sheets(i).Name <> s1.Name Then
        yeni = s1.Cells(Rows.Count, "A").End(3).Row + 1
        s1.Cells(yeni, "A") = Sheets(i).Name
        s1.Cells(yeni, "B") = Sheets(i).[G7]
    End If
Next
End Sub

Hocam çok teşekkür ederim.. Tam istediğim buydu.