Soru Sayfalar Arası Kopyala/Yapıştır Hakkında.

[yesimgurol]

Merhabalar,
Aktif çalışma sayfası içerisinde yer alan ilgili değerleri çıktı almak için oluşturmuş olduğum taslak sayfaya aldırmak istemekteyim. Kendi çabamla makro kaydet yardımı ile yapmaya çalıştığımda kısmen yapabilsem de hücrelerdeki birleştirmelerden kaynaklı tam olarak başaramadım maalesef:-(
Gerekli olan açıklamayı ekteki dosya üzerinde anlatmaya çalıştım. En azından bir kaç değerin getirilmesi ile ilgili kodlar olur ise ben kendimce bakarak diğer kısımları yapabilirim diye düşünüyorum.

 

[ÖmerFaruk]

Sorunuzun 1. kısmı için aşağıdaki kodu kullanabilirsiniz.

Sub Kopyala()
Dim Sh1 As Worksheet, Sh2 As Worksheet
    Set Sh1 = Worksheets("YAZDIR TASLAK")
    Set Sh2 = Worksheets("TASLAK HESAPLAMA")
    
    Sh2.Range("L5:L12").Copy
    Sh1.Range("J18:J25").PasteSpecial xlPasteValues
    
    Sh2.Range("Q5:Q12").Copy
    Sh1.Range("O18:O25").PasteSpecial xlPasteValues
    
    Sh2.Range("AD4:AD5").Copy
    Sh1.Range("J28:J29").PasteSpecial xlPasteValues

    Set Sh1 = Nothing: Set Sh2 = Nothing
End Sub

 

[ÖmerFaruk]

Önceki mesajı dikkate almayın lütfen.
Her iki sorunuzun cevabı da aşağıda

Sub Kopyala()
Dim Sh1 As Worksheet, Sh2 As Worksheet
    Set Sh1 = Worksheets("YAZDIR TASLAK")
    Set Sh2 = Worksheets("TASLAK HESAPLAMA")
    
    For i = 0 To 7
    Sh1.Range("J18").Offset(i, 0) = Sh2.Range("L5").Offset(i, 0)
    Sh1.Range("O18").Offset(i, 0) = Sh2.Range("Q5").Offset(i, 0)
    Next i
    Sh1.Range("J28") = Sh2.Range("AD4")
    Sh1.Range("J29") = Sh2.Range("AD5")

    Metin = Sh1.Range("B5").Value
    Dizi = Split(Metin, " ")
    For i = 0 To UBound(Dizi) - 1
        If Dizi(i) & Dizi(i + 1) = "ayıgelirlerinden;" Then
            Dizi(i - 2) = Sh2.Range("B2").Value
            Dizi(i - 1) = Sh2.Range("E2").Value
            Exit For
        End If
    Next i
    Sh1.Range("B5") = Join(Dizi, " ")
    Set Sh1 = Nothing: Set Sh2 = Nothing
End Sub

 

[yesimgurol]

Önceki mesajı dikkate almayın lütfen.
Her iki sorunuzun cevabı da aşağıda

Sub Kopyala()
Dim Sh1 As Worksheet, Sh2 As Worksheet
    Set Sh1 = Worksheets("YAZDIR TASLAK")
    Set Sh2 = Worksheets("TASLAK HESAPLAMA")
   
    For i = 0 To 7
    Sh1.Range("J18").Offset(i, 0) = Sh2.Range("L5").Offset(i, 0)
    Sh1.Range("O18").Offset(i, 0) = Sh2.Range("Q5").Offset(i, 0)
    Next i
    Sh1.Range("J28") = Sh2.Range("AD4")
    Sh1.Range("J29") = Sh2.Range("AD5")

    Metin = Sh1.Range("B5").Value
    Dizi = Split(Metin, " ")
    For i = 0 To UBound(Dizi) - 1
        If Dizi(i) & Dizi(i + 1) = "ayıgelirlerinden;" Then
            Dizi(i - 2) = Sh2.Range("B2").Value
            Dizi(i - 1) = Sh2.Range("E2").Value
            Exit For
        End If
    Next i
    Sh1.Range("B5") = Join(Dizi, " ")
    Set Sh1 = Nothing: Set Sh2 = Nothing
End Sub

Ömer bey merhaba,
İlginize ve emeğinize çok ama çok teşekkür ederim gerçekten.. Tamda istemiş olduğum gibi olmuş. Emeğinize sağlık, sağlıklı günler dilerim.

 

[yesimgurol]

For i = 0 To 7 Sh1.Range("J18").Offset(i, 0) = Sh2.Range("L5").Offset(i, 0) Sh1.Range("O18").Offset(i, 0) = Sh2.Range("Q5").Offset(i, 0)

Ömer bey kusura bakmayın yapmaya çalıştım ama olmadı nedense. Yukarıdaki kodu örnek alarak bende bir satır ekledim değerleri alamadım.:-( Nerede yanlış yaptım acaba:-(
Yukardaki satırların altına eklediğim kısım;

Sh1.Range("T18").Offset(i, 0) = Sh2.Range("V5").Offset(i, 0)

 

[yesimgurol]

Ömer bey tamamdır şimdi oldu. Tekrar çok teşekkür eder iyi çalışmalar dilerim.

 

[yesimgurol]

Metin = Sh1.Range("B5").Value
    Dizi = Split(Metin, " ")
    For i = 0 To UBound(Dizi) - 1
        If Dizi(i) & Dizi(i + 1) = "ayıgelirlerinden;" Then
            Dizi(i - 2) = Sh2.Range("B2").Value
            Dizi(i - 1) = Sh2.Range("E2").Value
            Exit For
        End If
    Next i
    Sh1.Range("B5") = Join(Dizi, " ")
    Set Sh1 = Nothing: Set Sh2 = Nothing

Ömer bey tekrar merhabalar,
Kusura bakmayın sizden bir ricam daha olacaktı. Oluşturmuş olduğum sayfayı kullanmaya başladım yalnız bir kaç hususta ekleme yapmam gerekti. Sizin #3 nolu mesajınızda yer alan ve yukarıya yazmış olduğum kod ile yapmaya çalıştım fakat başaramadım:-(

Ekleme yaptığım kısımlar ile ilgili kısaca bilgi vermem gerekir ise ;

"YAZDIR TASLAK" sayfasındaki "B31" ,
"YAZDIR TASLAK" sayfasındaki "B32"
"YAZDIR TASLAK" sayfasındaki "B33" hücrelerine metin ekledim.

Eklemiş olduğum bu metinler içerisinde yer alan bir karakteri, "TASLAK HESAPLAMA" sayfasındaki ilgili hücreler ile güncellemek istiyorum. (yukarıya almış olduğum koda benzer şekilde)

Ekte bulunan dosyam içerisindeki açıklama penceresinde de güncellenecek değerleri belirtmeye çalıştım.

 

[ÖmerFaruk]

Ben B31 için olanı göstereyim. Diğer 2 hücreniz için aynı satırları hemen altına kopyalayıp hücre adreslerini değiştirebilirsiniz.

Bu kodları Set Sh1 = Nothing: Set Sh2 = Nothing satırının üstüne yerleştirin

    x1 = InStr(1, Sh1.Range("B31"), "%")
    x2 = InStr(x1, Sh1.Range("B31"), "'")
    Part1 = Left(Sh1.Range("B31"), x1)
    Part2 = Mid(Sh1.Range("B31"), x2, Len(Sh1.Range("B31")) - x2 + 1)
    Sh1.Range("B31") = Part1 & Sh2.Range("B19") & Part2

 

[yesimgurol]

Ben B31 için olanı göstereyim. Diğer 2 hücreniz için aynı satırları hemen altına kopyalayıp hücre adreslerini değiştirebilirsiniz.

Bu kodları Set Sh1 = Nothing: Set Sh2 = Nothing satırının üstüne yerleştirin

    x1 = InStr(1, Sh1.Range("B31"), "%")
    x2 = InStr(x1, Sh1.Range("B31"), "'")
    Part1 = Left(Sh1.Range("B31"), x1)
    Part2 = Mid(Sh1.Range("B31"), x2, Len(Sh1.Range("B31")) - x2 + 1)
    Sh1.Range("B31") = Part1 & Sh2.Range("B19") & Part2

Ömer bey merhaba,
Gerçekten harikasınız, çok ama çok teşekkür ederim. İlginiz ve emeğiniz için.. Tam istediğim şekilde oldu sayenizde, iyi çalışmalar diliyorum.