kopyalanan hücrenin değerler olarak gelmesi

Katılım
31 Temmuz 2017
Mesajlar
63
Excel Vers. ve Dili
office 2013
Merhaba,

Öncelikle belirtmek isterim ki sitenin dizayn 'ı başarılı gözüküyor. Umarım hızlı bir gelişme içerisinde güzel sonuçlar elde edersiniz. Hayırlı olsun

Belirttiğim kod üzerinde kopyalanan değerler içerisinde bazı hücrelerde formüller mevcuttur. Makroyu çalıştırıp kopyalanan hücreleri farklı bir yere yapıştırdığında formülleri de alıyor ve haliyle sonuçlar değişiyor.
İstediğim şey belirttiğim kod üzerinde kopyalanan hücrelerin değerleri veya metin olarak yapıştırılmasını istiyorum.

Not: kopyalanan yerde, resimler ve renkli hücreler mevcuttur. Yani kaynak biçimlendirilmesi bozulmadan ama formül bulunan hücreleri değeri gelecek şekilde yapıştırılmasını istiyorum. yardımcı olabilirseniz sevinirim. Teşekkürler

s3.Select
Set Alan = s3.Range("a16:g65536")
For Each resimm In ActiveSheet.Pictures
If Not Intersect(resimm.TopLeftCell, Alan) Is Nothing Then
resimm.Delete
End If
Next
Set Alan = Nothing
Sheets("Liste").Select

For i = 2 To s1.Range("d65536").End(xlUp).Row
If s1.Cells(i, "d") = "X" Or s1.Cells(i, "d") = "x" Then
satbaş = s1.Cells(i, "e")
satbit = s1.Cells(i, "f")
ypştr = s1.Cells(i, "h")

s2.Select
Range("A" & satbaş & ":G" & satbit).Select
Selection.Copy
s3.Select
Range("A" & ypştr).Select
ActiveSheet.Paste
End If
Next i
s3.Range("a16").Select
s1.Select
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Range("A" & ypştr).Select
ActiveSheet.Paste

yukarıdaki kodun yerine aşağıdakini kullanın.:cool:

Range("A" & ypştr).PasteSpecial xlPasteValuesAndNumberFormats
 
Katılım
31 Temmuz 2017
Mesajlar
63
Excel Vers. ve Dili
office 2013
İlginiz için teşekkürler.
Malesef yukarıda bahsettiğim gibi kopyalanan değerler içerisinde bulunan renkli hücreler ve bir adet resim mevcut,
bahsettiğiniz kod ile yapıştırınca tüm değerleri düz bir şekilde yapıştırıyor.
Kaynak biçimlendirilmesi bozulmadan yapıştırılması için nasıl yapılıyor bilmiyorum
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
13,002
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
► Aşağıdaki gibi deneyin (ilk satır değeri, ikinci satır biçimi kopyalar).
Kod:
    Range("A" & ypştr).PasteSpecial Paste:=xlPasteValues
    Range("A" & ypştr).PasteSpecial Paste:=xlPasteFormats
► Ayrıca;
-- kodlarda kullanacağınız değişken adlarında Türkçe karakter (
Ş, ş, Ç, ç, Ğ, ğ gibi) kullanmayınız,
-- kodlada mümkün olduğunca ...Select kodu kullanmayınız (
A1.Select bir satır Selection.Copy diye ikinci bir satır yerine A1.Copy gibi tek satır yazabilirsiniz)
.
 
Katılım
31 Temmuz 2017
Mesajlar
63
Excel Vers. ve Dili
office 2013
► Aşağıdaki gibi deneyin (ilk satır değeri, ikinci satır biçimi kopyalar).
Kod:
    Range("A" & ypştr).PasteSpecial Paste:=xlPasteValues
    Range("A" & ypştr).PasteSpecial Paste:=xlPasteFormats
► Ayrıca;
-- kodlarda kullanacağınız değişken adlarında Türkçe karakter (
Ş, ş, Ç, ç, Ğ, ğ gibi) kullanmayınız,
-- kodlada mümkün olduğunca ...Select kodu kullanmayınız (
A1.Select bir satır Selection.Copy diye ikinci bir satır yerine A1.Copy gibi tek satır yazabilirsiniz)
.

Ömer Bey,
Bahsettiğinizi yaptım tek eksik, bulunan alanda bir tane resim var onu almıyor. Geri kalan hepsi tam istediğim gibi oldu.
 
Katılım
31 Temmuz 2017
Mesajlar
63
Excel Vers. ve Dili
office 2013
Bahse konu resim D-E-F sütunları içerisinde yer almaktadır.
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
13,002
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Tekrar merhaba.

İlgilenebilir miyim bilemiyorum, zira sabah iş seyehatine çıkacağım için hazırlık yapmaktayım.

Sorunuzu, gereksiz karşılıklı cevaplarla uzamaması bakımından,
gerçek belgenizin küçük boyutlu bir kopyası şeklinde,
kullandığınız kodlar, ilgili olabilecek formüller ve belirttiğiniz resim/resimler de içerisinde olacak şekilde hazılayacağınız
bir örnek belge üzerinden sorarsanız daha hızlı sonuca ulaşabilirsiniz.
(resimlerin boyutları-konumu-ismi gibi şeyler önemli olabilir)
.
 
Katılım
31 Temmuz 2017
Mesajlar
63
Excel Vers. ve Dili
office 2013
Dosya büyük olduğu için ana dosyadan mevcut olduğu kadar kırparak örnek bir çalışma yapmaya çalıştım. (ekte excel)

Liste sekmesinde bulunan ürünlerin "D" sütunun da ürüne karşılık gelen hücre eğer "X" ile doldurulursa "I" sütununda bulunan formüllü fiyat, makro bağlantısı ile birlikte önce "ürünler" sekmesinden ilgili ürünü kopyalıyor sonra "teklif" sekmesine ilgili alana yapıştırılıyor.

Şuan bu yaptığım örnek çalışmada makro yu çalıştıramadım ama mevcut ana dosyada şuan her şey normal şekilde çalışıyor.
Tek sorun en son Ömer bey 'in dediği güncelleme ile birlikte ;

Range("A" & ypştr).PasteSpecial Paste:=xlPasteValues
Range("A" & ypştr).PasteSpecial Paste:=xlPasteFormats

ürünler sekmesi "A4" hücresinde bulunan formül, değerler şeklinde "teklif" sekmesine mükemmel olarak getiriyor.

Soru;
Ürünler sekmesinde bulunan ilgili ürüne ait olan resim bu yapılan güncelleme ile birlikte gelmiyor. Ben hem resmin ve hemde a4 üzerinde bulunan formülün değerler şeklinde gelmesi için çalışıyorum.

Yardımcı olabilecek arkadaşlara şimdiden çok teşekkür ederim.
 

Ekli dosyalar

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
13,002
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Merhaba.

Tam anlamış değilim ama; sayfadaki DÜĞME ile aşağıdaki kod blokunu ilişkilendirerek deneyin.
.
Kod:
Sub deneme()
Set s1 = Sheets("liste"):  Set s2 = Sheets("ürünler"): Set s3 = Sheets("teklif")
Set Alan = s3.Range("a16:g65536")
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For Each resimm In s3.Pictures
    If Not Intersect(resimm.TopLeftCell, Alan) Is Nothing Then
        resimm.Delete
    End If
Next
Set Alan = Nothing
For i = 2 To s1.Range("d65536").End(xlUp).Row
    If s1.Cells(i, "d") = "X" Or s1.Cells(i, "d") = "x" Then
        satbaş = s1.Cells(i, "e"): satbit = s1.Cells(i, "f"): ypştr = s1.Cells(i, "h")
        s3.Cells.UnMerge: s2.Range("A" & satbaş & ":G" & satbit).Copy
        s3.Range("A" & ypştr).PasteSpecial Paste:=xlPasteValues
        s3.Range("A" & ypştr).PasteSpecial Paste:=xlPasteFormats
        s3.Columns("A:A").AutoFit
        Set Alan2 = s2.Range("A" & satbaş & ":G" & satbit)
        For Each resimm In s2.Pictures
            If Not Intersect(resimm.TopLeftCell, Alan2) Is Nothing Then
                resimm.Copy: s3.Activate
                s3.Cells(satbaş + 4 + 17, 4).Select: ActiveSheet.Paste
                s3.Cells(satbaş + 18, 1).Select
            End If
        Next
    End If
Next i
s1.Activate
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem TAMAM.", vbInformation
End Sub
 
Son düzenleme:
Katılım
31 Temmuz 2017
Mesajlar
63
Excel Vers. ve Dili
office 2013
Benim tek istediğim şey yukarıda belirttiğim çalışan kod üzerinde, ilgili ürünleri kopyala yapıştır yapabiliyor her şey normal. Fakat yukarıda yüklediğim örnek excel içerisinde ürünler sekmesinde bulunan resmi (yeşil kıyafetli olan adam veya herhangi bir resimde olabilir) 'de yapıştırılması gereken yere gelmiyor
.
Yani yukarıda ilk belirttiğiniz düzeltme kodu ile beraberinde başka bir satır daha yazılması gerekiyor ki hücre üzerinde bulunan resimleri de kopyalayıp yapıştırabileyim.

s3.Range("A" & ypştr).PasteSpecial Paste:=xlPasteValues
s3.Range("A" & ypştr).PasteSpecial Paste:=xlPasteFormats

Bundan önce bu satırlar yerine;

Range("A" & ypştr).Select
ActiveSheet.Paste

şeklinde yazıyordu ve herşeyi yapıştırabiliyordum. Ve haliyle resimde dahil hepsini geliyordu. Fakat içerisinde formüller bulunan bazı hücreler olduğu için bu yapıştırma stili benim işimi bozuyordu. Ben hem formülleri değerleri şeklinde gelmesini hemde taralı alanın içerisinde bulunan resimlerinde gelmesini istiyorum.
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
13,002
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
O zaman aşağıdaki gibi deneyin.
Kod:
Sub deneme2()
Set s1 = Sheets("liste"):  Set s2 = Sheets("ürünler"): Set s3 = Sheets("teklif")
Set Alan = s3.Range("a16:g65536")
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For Each resimm In s3.Pictures
    If Not Intersect(resimm.TopLeftCell, Alan) Is Nothing Then
        resimm.Delete
    End If
Next
Set Alan = Nothing
For i = 2 To s1.Range("d65536").End(xlUp).Row
    If s1.Cells(i, "d") = "X" Or s1.Cells(i, "d") = "x" Then
        satbaş = s1.Cells(i, "e"): satbit = s1.Cells(i, "f"): ypştr = s1.Cells(i, "h")
        s3.Cells.UnMerge: s2.Range("A" & satbaş & ":G" & satbit).Copy s3.Range("A" & ypştr)
        s3.Range("A" & ypştr).PasteSpecial Paste:=xlPasteValues
    End If
Next i
s3.Columns("A:A").AutoFit: s1.Activate
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem TAMAM.", vbInformation
End Sub
 
Katılım
31 Temmuz 2017
Mesajlar
63
Excel Vers. ve Dili
office 2013
Yapamadım :(

Bu arada çok üzülerek belirtmek istiyorum ki ben bir hata yaptım. ilk başta spoiler olarak verdiğim kod 'u eksik yapıştırmışım size. yanlış bir yönlendirme oldu sanırım

Bende mevcut olan kod bu şekildedir. aşağıdaki kodda sadece kopyalayıp yapıştırırken ilgili bölümde mevcut olan resimlerinde gelmesini istemiştim.

Kod:
Sub kopyala_yapıştır()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("Liste")
Set s2 = ThisWorkbook.Worksheets("ürünler")
Set s3 = ThisWorkbook.Worksheets("teklif")
s3.Range("a16:g65536").ClearContents
s3.Range("a16:g65536").Interior.ColorIndex = xlNone
s3.Range("a16:g65536").Borders.LineStyle = xlNone

s3.Select
Set Alan = s3.Range("a16:g65536")
For Each resimm In ActiveSheet.Pictures
If Not Intersect(resimm.TopLeftCell, Alan) Is Nothing Then
resimm.Delete
End If
Next
Set Alan = Nothing
Sheets("Liste").Select

For i = 2 To s1.Range("d65536").End(xlUp).Row
If s1.Cells(i, "d") = "X" Or s1.Cells(i, "d") = "x" Then
satbaş = s1.Cells(i, "e")
satbit = s1.Cells(i, "f")
ypştr = s1.Cells(i, "h")

    s2.Select
    Range("A" & satbaş & ":G" & satbit).Select
    Selection.Copy
    s3.Select
    Range("A" & ypştr).PasteSpecial Paste:=xlPasteValues
    Range("A" & ypştr).PasteSpecial Paste:=xlPasteFormats
   End If
   Next i
   s3.Range("a16").Select
s1.Select
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
13,002
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Benim verdiğim son kod cevabındaki;
s2.Range("A" & satbaş & ":G" & satbit).Copy s3.Range("A" & ypştr) kısmı biçimi, resimi ve formülleri ilgili alana yapıştırır,
s3.Range("A" & ypştr).PasteSpecial Paste:=xlPasteValues kısmı ise formül sonuçlarını değer olarak yapıştırır.

Ayrıca; sizin verdiğiniz son kod blokundaki aşağıdaki 3 satırın yerine sadece s3.Range("a16:g65536").Clear satırını kullanabilirsiniz
s3.Range("a16:g65536").ClearContents
s3.Range("a16:g65536").Interior.ColorIndex = xlNone
s3.Range("a16:g65536").Borders.LineStyle = xlNone
 
Son düzenleme:
Katılım
31 Temmuz 2017
Mesajlar
63
Excel Vers. ve Dili
office 2013
Ömer Bey, şuan şehir dışındayım en yakın zamanda dediklerinizi en baştan tekrar deniyor olacağım.
 
Katılım
31 Temmuz 2017
Mesajlar
63
Excel Vers. ve Dili
office 2013
Ömer BARAN
Süpersiniz ellerinize sağlık çok teşekkür ederim. Tam istediğim gibi oldu şimdi
 
Üst