Makro içinde formül bozulması

[ormann]

SAYIN ARKADAŞLAR SİZ DEĞERLİ HOCALARIMDAN ALDIĞIM DESTEKLE KENDİME GÖRE BİR PROGRAM YAPMAYA ÇALIŞIYORUM.FAKAT BİR YERDE TIKANTI KALDI.ÖRNEKTEKİ DOSYADA NIN VERİ GİRİŞİ BÖLÜMÜNDE BELİRTTİĞİM ŞEKİLDE D4143 HÜCRELERİNE BİR FOLMÜL YERLŞTİRDİM FAKAT BU FORMÜL BİLGİLERİ AKTAR BUTONUNA BASTIĞIMDA VERİLER SUÇ KAYDI BÖLÜMÜNE AKTARILIYO.AMA C3-D3-E3 HÜCRELERİNDEN ÇAĞIR DIĞIM ZAMAN FORMÜL BOZULUYO BUNU BİR TÜRLÜ ÇÖZEMEDİM.SAYFANIN KORUMA ŞİFRESİ:1978'dir.yardımlarınızı bekliyorum

 

[leumruk]

Merhaba,
Ben sorunu açıklayayım, siz düzenlemesini kendinize göre yapın.

s1.Range("B" & C.Row & ":AQ" & C.Row).Copy

Yukarıdaki kodda belirtilen aralıkta toplam 42 hücre var.
Kopyalamaya ayırdığınız bölümde ise toplam 35 hücre var.

Range("D5:d39").PasteSpecial xlPasteValues, xlNone, False, True

arada toplam 7 hücre var. Sizin anlayacağınız fazladan kopyaladığınız hücreleri sizin formüllerinizin üzerine yapıştırıyor. Kopyaladığınız alandaki hücre sayısını kopyalanacak aralıktaki hücre sayısıyla eşit tutmalısınız.

 

[ormann]

hocam ben yapamadım siz dosyayı düzenleyip gönderirseniz çok makbule geçer

 

[leumruk]

hocam ben yapamadım siz dosyayı düzenleyip gönderirseniz çok makbule geçer

Merhaba,
VERİ GİRİŞİ sayfasının kod bölümünde bulunan aşağıdaki kısmı değiştirin. Değiştirilen kısmı kırmızı ile belirttim.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C3:E3]) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Dim C As Range, s1 As Worksheet, say As Long
Set s1 = Sheets("SUÇ KAYDI")
say = Application.WorksheetFunction.Match(Target.Offset(-1, 0), s1.[3:3], 0)
Set C = s1.Columns(say).Find(Target.Value, LookIn:=xlValues)
If Not C Is Nothing Then
Sheets("VERİ GİRİŞİ").Unprotect 1978
Range("D5").ClearContents
s1.Range("B" & C.Row & ":[COLOR="DarkRed"]AK[/COLOR]" & C.Row).Copy
Range("D5:d39").PasteSpecial xlPasteValues, xlNone, False, True
Application.CutCopyMode = False
Range("C3").Select
Sheets("VERİ GİRİŞİ").Protect 1978
Else
    MsgBox Target.Value & " BİLGİSİNİ BULAMADIM"
End If
End Sub