Soru çalışma sayfa isimleri

[euphrates55]

makro ile çalışma sayfalarının isimlerini topluca sayfa1 sayfa2 diye nasıl değişebilirim. sonrasında da her sayfanın c4 hücresini altalta yazmam gerekiyor. sayfa isimlerini değişmeden bunu yapma yolu varsa o da olabilir tabi

 

[yanginci34]

Denermisiniz.

 

[euphrates55]

çok güzel olmuş... 32. sayfada nedense s2.Select kısmı hata verdi.

 

[yanginci34]

Dosyanızı görmem lazım hata vermemesi gerekir.

 

[euphrates55]

Dosyanızı görmem lazım hata vermemesi gerekir.

dosyayı maalesef gönderemeyeceğim. örnek yapmam da zaman alır. şöyle diyeyim. c4 hücresini değiştim denedim yine son 31. sayfaya gelip hata verdi. 32. sayfayı sildim denedim yine aynısını yaptı. teşekkür ederim

 

[yanginci34]

Ben size gönderdiğim dosyada denedim ama hiç hata vermedi.

 

[euphrates55]

Ben size gönderdiğim dosyada denedim ama hiç hata vermedi.

şunu yapabiliyormuyuz. sayfa dını değişmeye gerek yok. tüm sayfaların c4 hücrelerini alt alta yazsın mesela. gerisini ben halledebilirim.

 

[yanginci34]

Kodu aşağıdaki gibi değiştirip denermisiniz.

Sub SayfalariBirlestir()
Dim SayfaSira As Integer
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Toplu")
Application.ScreenUpdating = False
s1.Select
Range(Cells(2, "A"), Cells(65536, "a")).ClearContents
For SayfaSira = 1 To Sheets.Count
If Sheets(SayfaSira).Name <> "Toplu" Then
Set s2 = Sheets(SayfaSira)
s2.Select
Cells(4, 3).Copy
s1.Range("a" & s1.[a65536].End(3).Row + 1).PasteSpecial Paste:=xlPasteValues
End If
Next SayfaSira
s1.Select


Application.ScreenUpdating = True
End Sub

 

[euphrates55]

hay aksi. yine aynı. 31 tamam 32 ye geçemiyor

 

[yanginci34]

Dediğim gibi dosyanızı görmem gerek. Bunun haricinde yapılacak birşey yok

 

[euphrates55]

Dediğim gibi dosyanızı görmem gerek. Bunun haricinde yapılacak birşey yok

tşekkürler. muhtemelen sorun dosyada. yoksa baştan çalışmazdı. gerisi bende

 

[yanginci34]

Rica ederim. Kolay gelsin.

 

[euphrates55]

Rica ederim. Kolay gelsin.

gizli sekme varmış. olay çözüldü. tekrar teşekkürler. :=)

 

[Necdet]

Merhaba,

"Hata Verdi" açıklayıcı bir bilgi değil, hata kodunu da yazarsanız belki daha anlaşılır olur.

 

[euphrates55]

Kodu aşağıdaki gibi değiştirip denermisiniz.

Sub SayfalariBirlestir()
Dim SayfaSira As Integer
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Toplu")
Application.ScreenUpdating = False
s1.Select
Range(Cells(2, "A"), Cells(65536, "a")).ClearContents
For SayfaSira = 1 To Sheets.Count
If Sheets(SayfaSira).Name <> "Toplu" Then
Set s2 = Sheets(SayfaSira)
s2.Select
Cells(4, 3).Copy
s1.Range("a" & s1.[a65536].End(3).Row + 1).PasteSpecial Paste:=xlPasteValues
End If
Next SayfaSira
s1.Select


Application.ScreenUpdating = True
End Sub

Gerisi bende dedim ama beceremedim. kodu değişmek istedim . bu seferde toplu sayfasında b2 den aşağıya doğru. ve diğer tüm sayfaların c5 hücresini almasını istedim ve aşağıdaki kodu yazdım. ama sanırım beceremedim. karşılaştırma yaparsam bu sefer gerisi bende

Sub SayfalariBirlestir()
Dim SayfaSira As Integer
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Toplu")
Application.ScreenUpdating = False
s1.Select
Range(Cells(2, "B"), Cells(65536, "B")).ClearContents
For SayfaSira = 1 To Sheets.Count
If Sheets(SayfaSira).Name <> "Toplu" Then
Set s2 = Sheets(SayfaSira)
s2.Select
Cells(5, 3).Copy
s1.Range("B" & s1.[a65536].End(3).Row + 1).PasteSpecial Paste:=xlPasteValues
End If
Next SayfaSira
s1.Select


Application.ScreenUpdating = True
End Sub

 

[yanginci34]

Gerisi bende dedim ama beceremedim. kodu değişmek istedim . bu seferde toplu sayfasında b2 den aşağıya doğru. ve diğer tüm sayfaların c5 hücresini almasını istedim ve aşağıdaki kodu yazdım. ama sanırım beceremedim. karşılaştırma yaparsam bu sefer gerisi bende

Sub SayfalariBirlestir()
Dim SayfaSira As Integer
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Toplu")
Application.ScreenUpdating = False
s1.Select
Range(Cells(2, "B"), Cells(65536, "B")).ClearContents
For SayfaSira = 1 To Sheets.Count
If Sheets(SayfaSira).Name <> "Toplu" Then
Set s2 = Sheets(SayfaSira)
s2.Select
Cells(5, 3).Copy
s1.Range("B" & s1.[a65536].End(3).Row + 1).PasteSpecial Paste:=xlPasteValues
End If
Next SayfaSira
s1.Select


Application.ScreenUpdating = True
End Sub

Aşağıdaki gibi deneyin lütfen
Sub SayfalariBirlestir()
Dim SayfaSira As Integer
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Toplu")
Application.ScreenUpdating = False
s1.Select
Range(Cells(2, "B"), Cells(65536, "B")).ClearContents
For SayfaSira = 1 To Sheets.Count
If Sheets(SayfaSira).Name <> "Toplu" Then
Set s2 = Sheets(SayfaSira)
s2.Select
Cells(5, 3).Copy
s1.Range("B" & s1.[b65536].End(3).Row + 1).PasteSpecial Paste:=xlPasteValues
End If
Next SayfaSira
s1.Select

Application.ScreenUpdating = True
End Sub

GM 8 d cihazımdan Tapatalk kullanılarak gönderildi

 

[euphrates55]

bir harfle kaçırmışım tekrar teşekkürler...

 

[Korhan Ayhan]

Sayfalardaki C5 hücresinin değerini alacaksanız kopyala yapıştır yapmanıza gerek yok. Aşağıdaki satırda işinizi görecektir.

Son = S1.Cells(Rows.Count, 2).End(3).Row + 1
S1.Cells(Son, 2).Value = Cells(5, 3).Value

 

[euphrates55]

Sayfalardaki C5 hücresinin değerini alacaksanız kopyala yapıştır yapmanıza gerek yok. Aşağıdaki satırda işinizi görecektir.

Son = S1.Cells(Rows.Count, 2).End(3).Row + 1
S1.Cells(Son, 2).Value = Cells(5, 3).Value

teşekkürler Korhan Bey. dediğiniz gibi de oldu.