Eğer ile sadece değerleri yazdırma ?

[Chrisis]

Merhaba üstadlar foruma yeni üye oldum ve işime yarayacak bütün başlıkları inceledim.Ama yapmak istediğimi yapamadım.

Yapmak istediğim ekli örnek dosyadaki DEĞER bölümü günlük güncellenecek,ve DÖKÜM sayfasındaki ilgili tarih bölümünün altına yazılacak.Ekteki gibi yazdırabiliyorum ama sadece değerleri DEĞER bölümünde güncellediğim zaman DÖKÜM bölümünde ilgili hücrelerin hepsi değişiyor.Eğer formülü ile özel yapıştır da olduğu gibi sadece değerleri yazdırabilme olanağım var mıdır ?
Kullandığım Kod :

=EĞER($B$2=DEĞER!$B$1;DEĞER!D4;0)

 

[Ömer]

Merhaba,

Bu işlemi formülle yapamazsınız, makro kullanmanız gerekir.

Module kopyalarak çalıştırınız..

Sub BulEkle()
 
Dim bul As Range, son As Long
Dim S1 As Worksheet, S2 As Worksheet
 
Set S1 = Sheets("DEĞER")
Set S2 = Sheets("DÖKÜM")
 
Application.ScreenUpdating = False
 
son = S1.Cells(Rows.Count, "B").End(xlUp).Row
Set bul = S2.Rows(2).Find(CDate(CDbl(S1.Range("B1"))), LookIn:=xlValues)
If Not bul Is Nothing Then
    S1.Range("D4:D" & son).Copy
    S2.Cells(3, bul.Column).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End If
 
Application.ScreenUpdating = True
End Sub

.

 

[emnozdemir]

Yukarıdaki kodları ekdeki dosyaya uyarlayabilirmiyiz?

 

[emnozdemir]

ekteki Dosyada "Döküm" Sayfasındaki Yan yana olan Ayları, yukarıdan aşaya olacak şekilde yapabilmemiz için aşağıdaki kodları nasıl yazmamız gerekir?

Sub BulEkle()

Dim bul As Range, son As Long
Dim S1 As Worksheet, S2 As Worksheet

Set S1 = Sheets("DEĞER")
Set S2 = Sheets("DÖKÜM")

Application.ScreenUpdating = False

son = S1.Cells(Rows.Count, "C").End(xlUp).Row
Set bul = S2.Rows(3).Find(CStr(CStr(S1.Range("B1"))), LookIn:=xlValues)
If Not bul Is Nothing Then
S1.Range("D" & son).Copy
S2.Cells(4, bul.Column).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If

Application.ScreenUpdating = True
End Sub

 

[Ömer]

Merhaba,

Bu şekilde deneyiniz.

Sub BulEkle()
 
Dim bul As Range, son As Long
Dim S1 As Worksheet, S2 As Worksheet
 
Set S1 = Sheets("DEĞER")
Set S2 = Sheets("DÖKÜM")
 
Application.ScreenUpdating = False
 
son = S1.Cells(Rows.Count, "A").End(xlUp).Row
Set bul = S2.Rows(3).Find(S1.Range("B1"), LookIn:=xlValues)
If Not bul Is Nothing Then
    S1.Range("D4:D" & son).Copy
    S2.Cells(4, bul.Column).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End If
 
Application.ScreenUpdating = True
End Sub

.

 

[emnozdemir]

Denedim Ama olmadı Ömer Hocam. Ekteki gibi aylar alt alta olacak şekilde olsun istemiştim.

 

[Ömer]

Denedim Ama olmadı Ömer Hocam. Ekteki gibi aylar alt alta olacak şekilde olsun istemiştim.

Diğer eklediğiniz dosyayı bu şekilde eklememiştiniz. Lütfen sorularınızı daha net sormaya özen gösteriniz.

Option Explicit
Sub BulEkle()
 
Dim bul As Range, son As Long
Dim S1 As Worksheet, S2 As Worksheet
 
Set S1 = Sheets("DEĞER")
Set S2 = Sheets("DÖKÜM")
 
Application.ScreenUpdating = False
 
son = S1.Cells(Rows.Count, "A").End(xlUp).Row
Set bul = S2.[B:B].Find(S1.Range("B1"), LookIn:=xlValues)
If Not bul Is Nothing Then
    S1.Range("D4").Copy
    S2.Range("C" & bul.Row).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End If
 
Application.ScreenUpdating = True
End Sub

.

 

[emnozdemir]

Süpersiniz Hocam. Beyninize ve emeğinize sağlık. Kaç gündür bu konu üzerinde çalışıyorum. Çözememek deli etti beni . Kaç tane mesaj yazdım. Sayenizde sonuca ulaştım. Çok teşekkür ediyorum.