Değer Yapıştır Makrosu

[nkeles]

Bu güne kadar tüm yardımlarına koşan siz değerli forum üyelerinden bir isteğim daha var.

Elimdeki Excel dosyamda 1 den 220 e kadar sayfa var. Sayfa isimleri sayı iledir. 1 2 3 4 5 6....... 220 ye kadar. Bu sayfalarda D9: E32 hücrelerindeki verileri aynı hücrelere Değer Yapıştır uygulamak istiyorum.

Yardımlarını bekliyorum..

 

[Orion1]

Kaynak sayfa 1 adlı sayfadır.
Yani 1 adlı sayfayı kopyalayıp diğer sayfalara yapıştırıyor.

Sub deger_paste_59()
Dim i As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("1").Range("D9:E32").Copy
For i = 2 To 220
    Sheets(CStr(i)).Range("D9").PasteSpecial (xlPasteValues)
Next
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub

 

[nkeles]

Kaynak dosya sayfaların kendisi zaten. Ancak Sayfalarda formül var ve ben o formülleri kullanmak istemiyorum. Tek tek iptal yerine de böyle bir şey istedim. 1 nolu sayfanın ki 1 nolu sayfaya Değer yapıştır, 5 nolu sayfadaki de 5 nolu sayfaya değer yapıştır yapsın istiyorum. 1 nolu sayfayı diğer sayfalara yapıştırsın istemiyorum... Yinede teşekkürler..

 

[Orion1]

Kaynak dosya sayfaların kendisi zaten. Ancak Sayfalarda formül var ve ben o formülleri kullanmak istemiyorum. Tek tek iptal yerine de böyle bir şey istedim. 1 nolu sayfanın ki 1 nolu sayfaya Değer yapıştır, 5 nolu sayfadaki de 5 nolu sayfaya değer yapıştır yapsın istiyorum. 1 nolu sayfayı diğer sayfalara yapıştırsın istemiyorum... Yinede teşekkürler..

Hangi aralığı kopyalayıp hangi aralığa yapıştıracaz?

 

[nkeles]

Hangi aralığı kopyalayıp hangi aralığa yapıştıracaz?

Örnek 1. sayfadaki D9: E32 aralığını 1. sayfadaki D9: E32 Değer yapıştır
5. sayfadaki D9: E32 aralığını 5. sayfadaki D9: E32 Değer yapıştır
19. sayfadaki D9: E32 aralığını 19. sayfadaki D9: E32 Değer yapıştır
49. sayfadaki D9: E32 aralığını 49. sayfadaki D9: E32 Değer yapıştır
128. sayfadaki D9: E32 aralığını 128. sayfadaki D9: E32 Değer yapıştır

Aynı sayfadaki D9: E32 aralığını yine aynı sayfadaki D9: E32 Değer yapıştır yapmasını istiyorum.

 

[Orion1]

Örnek 1. sayfadaki D9: E32 aralığını 1. sayfadaki D9: E32 Değer yapıştır
5. sayfadaki D9: E32 aralığını 5. sayfadaki D9: E32 Değer yapıştır
19. sayfadaki D9: E32 aralığını 19. sayfadaki D9: E32 Değer yapıştır
49. sayfadaki D9: E32 aralığını 49. sayfadaki D9: E32 Değer yapıştır
128. sayfadaki D9: E32 aralığını 128. sayfadaki D9: E32 Değer yapıştır

Aynı sayfadaki D9: E32 aralığını yine aynı sayfadaki D9: E32 Değer yapıştır yapmasını istiyorum.

Buyurun.

Sub deger_paste_59()
Dim i As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For i = 1 To 220
    Sheets(CStr(i)).Range("D9:E32").Copy
    Sheets(CStr(i)).Range("D9").PasteSpecial (xlPasteValues)
Next
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub

 

[nkeles]

Harikasın kardeşim sağol..

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
[e5].Value = ActiveSheet.Name
End Sub

Şöyle bir kod var. Sayfa ismini istediğin hücreye taşıyor. Ben bu kodu sadece 1 den 220 ye kadar ki sayfalara uygulamak istiyorum. Diğer sayfalar bundan etkilenmesin. Nasıl yapabilirim.

 

[Orion1]

Harikasın kardeşim sağol..

Şöyle bir kod var. Sayfa ismini istediğin hücreye taşıyor. Ben bu kodu sadece 1 den 220 ye kadar ki sayfalara uygulamak istiyorum. Diğer sayfalar bundan etkilenmesin. Nasıl yapabilirim.

Buyurun.

If IsNumeric(ActiveSheet.Name) Then
    If CDbl(ActiveSheet.Name) >= 1 And CDbl(ActiveSheet.Name) <= 220 Then
        [e5].Value = ActiveSheet.Name
    End If
End If

 

[Korhan Ayhan]

Merhaba,

Sayfalardaki formülleri değere çevirmek için alternatif olarak kopyalama yönteminin dışında aşağıdaki koduda kullanabilirsiniz.

Sub FORMÜLLERİ_DEĞERE_ÇEVİR()
    Dim X As Byte, Sayfa As Worksheet
    
    Application.ScreenUpdating = False
    
    For X = 1 To 220
        On Error Resume Next
        Set Sayfa = Sheets(CStr(X))
        On Error GoTo 0
        If Not Sayfa Is Nothing Then
            Sheets(CStr(X)).Range("D9:E32").Value = Sheets(CStr(X)).Range("D9:E32").Value
        End If
        Set Sayfa = Nothing
    Next
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[cayaso]

Benim sıkıntım da buna benzer. 1,2,3,4,5 .....100 diye adlandırılmış sayfalarım mevcut. 1 adlı sayfanın AT2 hücresinde bulunan veriyi değeri ile "isim" adlı sayfanın C2 hücresine, 2 adlı sayfanın AT2 hücresinde bulunan veriyi değeri ile yine "isim" adlı sayfanın C3 hücresine en son 100 adlı sayfanın AT2 hücresinde bulunan veriyi de "isim" adlı sayfanın C101 hücresine yapıştıracak makro gerekli. Uğraşmama rağmen yapamadım. Teşekkür ederim.