istenilen sayfaya veri aktarma

[redje]

merhabalar;

Aşağıdaki makroyu araştırarak buldum işimi gördüğü yerlerde var fakat bu makroyla başka yapmak istediğim bir durum daha var
maashesap bilgilerini (maashesapyedek) sayfasına getiriyor aynı şekilde yine getirsin yalnız benim isteğim sayfa1 de a2 hücresine hangi sayfa ismini yazarsam o sayfaya bilgileri aktarsın istiyom (sayfa1deki a2 hücresine sayfa5 yazarsam bilgiler sayfa5 e aktarılsın istiyom ) mümkünse yardımlarınız için teşekkürler.


Sub Liste_Aktar()
ss = Sheets("maashesapyedek").[A65536].End(3).Row
s = [maashesap!A500].End(3).Row
For i = 5 To s
ss = ss + 1
With Sheets("maashesapyedek")
.Cells(ss, 1).Value = ss - 5
.Cells(ss, 2).Value = Sheets("maashesap").Cells(i, 3).Value
.Cells(ss, 3).Value = Sheets("maashesap").Cells(i, 3).Value
.Cells(ss, 4).Value = Sheets("maashesap").Cells(i, 4).Value
.Cells(ss, 5).Value = Sheets("maashesap").Cells(i, 5).Value
.Cells(ss, 6).Value = Sheets("maashesap").Cells(i, 6).Value
.Cells(ss, 7).Value = Sheets("maashesap").Cells(i, 7).Value
.Cells(ss, 8).Value = Sheets("maashesap").Cells(i, 8).Value
.Cells(ss, 9).Value = Sheets("maashesap").Cells(i, 9).Value
.Cells(ss, 10).Value = Sheets("maashesap").Cells(i, 10).Value
.Cells(ss, 11).Value = Sheets("maashesap").Cells(i, 11).Value



End With
Next i
MsgBox "RAPORA AKTARIM BAŞARILI.", vbInformation, "Bilgi"

son:
If Err.Number <> 0 Then MsgBox "Aktarmada Hata Oluştu.", vbInformation, "Bilgi"
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[mustafaine1]

Sub Liste_Aktar()

[COLOR="Red"]dim sayfaismi As string
sayfaismi = [a2].value[/COLOR]

ss = Sheets([COLOR="Red"]sayfaismi[/COLOR]).[A65536].End(3).Row
s = [maashesap!A500].End(3).Row
For i = 5 To s
ss = ss + 1
With Sheets([COLOR="Red"]sayfaism[/COLOR]i)
.Cells(ss, 1).Value = ss - 5
.Cells(ss, 2).Value = Sheets("maashesap").Cells(i, 3).Value
.Cells(ss, 3).Value = Sheets("maashesap").Cells(i, 3).Value
.Cells(ss, 4).Value = Sheets("maashesap").Cells(i, 4).Value
.Cells(ss, 5).Value = Sheets("maashesap").Cells(i, 5).Value
.Cells(ss, 6).Value = Sheets("maashesap").Cells(i, 6).Value
.Cells(ss, 7).Value = Sheets("maashesap").Cells(i, 7).Value
.Cells(ss, 8).Value = Sheets("maashesap").Cells(i, 8).Value
.Cells(ss, 9).Value = Sheets("maashesap").Cells(i, 9).Value
.Cells(ss, 10).Value = Sheets("maashesap").Cells(i, 10).Value
.Cells(ss, 11).Value = Sheets("maashesap").Cells(i, 11).Value



End With
Next i
MsgBox "RAPORA AKTARIM BAŞARILI.", vbInformation, "Bilgi"

son:
If Err.Number <> 0 Then MsgBox "Aktarmada Hata Oluştu.", vbInformation, "Bilgi"
Set s1 = Nothing
Set s2 = Nothing
End Sub

Bu sekilde denermisiniz..

 

[halit3]

böyle denermisiniz.

Sub Liste_Aktar()
yer = Sheets("Sayfa1").Range("A2").Value
ss = Sheets(yer).[A65536].End(3).Row
For i = 5 To s
ss = ss + 1
With Sheets(yer)
.Cells(ss, 1).Value = ss - 5
.Cells(ss, 2).Value = Sheets("maashesap").Cells(i, 3).Value
.Cells(ss, 3).Value = Sheets("maashesap").Cells(i, 3).Value
.Cells(ss, 4).Value = Sheets("maashesap").Cells(i, 4).Value
.Cells(ss, 5).Value = Sheets("maashesap").Cells(i, 5).Value
.Cells(ss, 6).Value = Sheets("maashesap").Cells(i, 6).Value
.Cells(ss, 7).Value = Sheets("maashesap").Cells(i, 7).Value
.Cells(ss, 8).Value = Sheets("maashesap").Cells(i, 8).Value
.Cells(ss, 9).Value = Sheets("maashesap").Cells(i, 9).Value
.Cells(ss, 10).Value = Sheets("maashesap").Cells(i, 10).Value
.Cells(ss, 11).Value = Sheets("maashesap").Cells(i, 11).Value
End With
Next i
MsgBox "RAPORA AKTARIM BAŞARILI.", vbInformation, "Bilgi"
son:
If Err.Number <> 0 Then MsgBox "Aktarmada Hata Oluştu.", vbInformation, "Bilgi"
Set s2 = Nothing
End Sub

 

[redje]

merhabalar;

aktarım başarılı diyor fakat aktarmıyor

sayınmusatafaine
sizin ektede bu satırda hata veriyo
ss = Sheets(maashesap).[A65536].End(3).Row
bu satırda hata veriyo

 

[halit3]

merhabalar;

aktarım başarılı diyor fakat aktarmıyor

sayınmusatafaine
sizin ektede bu satırda hata veriyo
ss = Sheets(maashesap).[A65536].End(3).Row
bu satırda hata veriyo

kırmızı yeri yanlışlıkla silmişim ekleyiniz.

Sub Liste_Aktar()
yer = Sheets("Sayfa1").Range("A2").Value
ss = Sheets(yer).[A65536].End(3).Row
[COLOR=red]s = [maashesap!A500].End(3).Row[/COLOR]
For i = 5 To s
ss = ss + 1
With Sheets(yer)
.Cells(ss, 1).Value = ss - 5
.Cells(ss, 2).Value = Sheets("maashesap").Cells(i, 3).Value
.Cells(ss, 3).Value = Sheets("maashesap").Cells(i, 3).Value
.Cells(ss, 4).Value = Sheets("maashesap").Cells(i, 4).Value
.Cells(ss, 5).Value = Sheets("maashesap").Cells(i, 5).Value
.Cells(ss, 6).Value = Sheets("maashesap").Cells(i, 6).Value
.Cells(ss, 7).Value = Sheets("maashesap").Cells(i, 7).Value
.Cells(ss, 8).Value = Sheets("maashesap").Cells(i, 8).Value
.Cells(ss, 9).Value = Sheets("maashesap").Cells(i, 9).Value
.Cells(ss, 10).Value = Sheets("maashesap").Cells(i, 10).Value
.Cells(ss, 11).Value = Sheets("maashesap").Cells(i, 11).Value
End With
Next i
MsgBox "RAPORA AKTARIM BAŞARILI.", vbInformation, "Bilgi"
son:
If Err.Number <> 0 Then MsgBox "Aktarmada Hata Oluştu.", vbInformation, "Bilgi"
Set s2 = Nothing
End Sub

 

[redje]

çok teşekkür ederim süper oldu başka amacım içinde yol oldu yardımlarınız tekrar teşekkürler
iyi çalışmalar.

 

[halit3]

çok teşekkür ederim süper oldu başka amacım içinde yol oldu yardımlarınız tekrar teşekkürler
iyi çalışmalar.

iyi çalışmalar

 

[isyaan]

ss = Sheets("maashesapyedek").[A65536].End(3).Row
s = [maashesap!A500].End(3).Row
For i = 5 To s
ss = ss + 1
With Sheets("maashesapyedek")
.Cells(ss, 1).Value = ss - 5
.Cells(ss, 2).Value = Sheets("maashesap").Cells(i, 3).Value



yukarıdaki satırları açıklyacak bir babayiğit varmı ?