Aynı dosyada belli bir sayfaya veri aktarma

[islergucler]

Ekli dosyayı görüntüle 142100Arkadaşlar merhaba,
Bir excel dosyam var ve bu dosya içinde çeşitli sayfalar var.Bu sayfalardan birtanesinin ismi "Data". Ben diğer sayfalardaki belli hücreyi "Data" dosyasına çekmek istiyorum. Yazdığım kod şöyle,

Sub Al()
Dim ilk As Integer
Dim son As Integer
Dim i As Integer
ilk = 3
son = Sheets("Data").Cells(Rows.Count, "B").End(xlUp).Row
Dim k As String

For i = ilk To son
If k = Worksheets("Data").Range("B" & i).Value Then

Worksheets(k).Activate
Range("B" & i).Copy Worksheets("Data").Range("C" & i).Value
End If

Next i

End Sub

Teşekkür ederim,

 

[asi_kral]

Merhaba
Sorunuzu anlamadım. Dosyanın içindeki soru ise sayfa adları birbirini tutmuyor.
Biraz daha açıklarsanız yardımcı olmaya çalışırım.

 

[islergucler]

Kimse yok mu?

 

[islergucler]

Merhaba
Sorunuzu anlamadım. Dosyanın içindeki soru ise sayfa adları birbirini tutmuyor.
Biraz daha açıklarsanız yardımcı olmaya çalışırım.

Öncelikle ilgi gözterdiğiniz için teşekkür ederim.
Sayfa ve soru isimlerini düzelttim.
Sorun şu;
Bir excel dosyam var.Bu dosyada birçok sayfa var.Bunlardan biri de "Data" sayfası. Ben öncelikle diğer sayfaların isimlerini alt alta "Data" sayfasına yazacağım. Makroyu çalıştırdığımda, bu yazdığım sayfa isimlerinin yanına o sayfalardaki "B2" hücreleri kopyalanacak.
Umarım anlatabildim derdimi.

Teşekkür ederim,

 

[dEdE]

Merhaba,
Aşağıdaki kodu dener misiniz?
"Ben öncelikle diğer sayfaların isimlerini alt alta "Data" sayfasına yazacağım. " Buna gerek yok istenirse sayfa adları da makro ile yazdırılabilir. Ya da Sayfa adını yazınca otomatik olarak B2 nin değeri getirilebilir.

Sub aktar()
For i = 1 To [B65536].End(3).Row
    If Sheets("Data").Cells(i, 2).Value <> "" Then
        S = Sheets("Data").Cells(i, 2).Value
        Sheets("Data").Cells(i, 3).Value = Sheets(S).[B2].Value
    End If
Next
End Sub

 

[islergucler]

Denedim ama "i" ve "S" in tanımlanmasını istiyor.
bunları nasıl tanımlamalıyız?

 

[islergucler]

Dim i As Integer
Dim S As String

olarak tanımladım ama bu sefer de "Subscript out of range" hatası verdi.

 

[dEdE]

Merhaba,
Dosyanız ektedir.

 

[islergucler]

Çok teşekkür ederim.
Kod aynı kod.
Ben buton eklemediğim için mi çalışmadı?

 

[islergucler]

Aynı işlemi ben boş bir excel sayfasında denediğimde "Subscript out of range" uyarısı alıyorum.
Bunu nasıl düzeltebilirim? Ya da ben nerede hata yapıyor olabilirim?

 

[islergucler]

Sub Getir()
Dim o As Integer

Dim W As String

For o = 3 To [B65536].End(3).Row

    If Sheets("Rapor").Range("B" & o).Value <> "" Then
        W = Sheets("Rapor").Range("B" & o).Value
        Sheets("Rapor").Range("D" & o).Value = Sheets(W).Range("D8").Value
        Sheets("Rapor").Range("E" & o).Value = Sheets(W).Range("D9").Value
        Sheets("Rapor").Range("F" & o).Value = Sheets(W).Range("D10").Value
        Sheets("Rapor").Range("G" & o).Value = Sheets(W).Range("D11").Value
        Sheets("Rapor").Range("H" & o).Value = Sheets(W).Range("D12").Value
        Sheets("Rapor").Range("I" & o).Value = Sheets(W).Range("D13").Value
        Sheets("Rapor").Range("J" & o).Value = Sheets(W).Range("C33").Value
        Sheets("Rapor").Range("K" & o).Value = Sheets(W).Range("C34").Value
        Sheets("Rapor").Range("N" & o).Value = Sheets(W).Range("C36").Value
    End If
Next
End Sub

yaptığımda belli bir yerden sonra data getirmiyor.
Sebep ne olabilir?