- Katılım
- 31 Temmuz 2017
- Mesajlar
- 63
- Excel Vers. ve Dili
- office 2013
- Altın Üyelik Bitiş Tarihi
- 23-07-2021
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
Ö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
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