Sayfalarda ara adet değiştir

[ADER_34]

Merhaba hayırlı akşamlar,arkadaşlar örnek sayfamda input giriş sayfası "A" sütundaki veriyi tüm sayfalarda arayıp bulup bulduğu değerin,adetini input sayfasında "D" sütunundaki değer kadar artırmasını hangi kodları kullanmalıyım teşekkür ederim kolay gelsin..

http://s8.dosya.tc/server2/ek724v/DEPO_DUZENI_ORNEK.rar.html

 

[Orion1]

Buyurun.

Sub aktartopla59()
Dim sh As Worksheet, sat As Long, sonsat As Long, k As Range
Sheets("İNPUT RAPOR").Select
Application.ScreenUpdating = False
For Each sh In Worksheets
    If sh.Name <> "İNPUT RAPOR" Then
        sonsat = sh.Cells(Rows.Count, "A").End(xlUp).Row
        For sat = 2 To sonsat
            Set k = Range("A2:A" & Rows.Count).Find(sh.Cells(sat, "A").Value, , xlValues, xlWhole)
            If Not k Is Nothing Then
                sh.Cells(sat, "D").Value = sh.Cells(sat, "D").Value + k.Offset(0, 3).Value
            End If
        Next sat
    End If
Next sh
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[ADER_34]

Evren Bey kodlarınızı denedim bu satırda hata verdi.sh.Cells(sat, "D").Value = sh.Cells(sat, "D").Value + k.Offset(0, 3).Value ne yapmama gerek

 

[Orion1]

Evren Bey kodlarınızı denedim bu satırda hata verdi.sh.Cells(sat, "D").Value = sh.Cells(sat, "D").Value + k.Offset(0, 3).Value ne yapmama gerek

Bende hata vermedi.
Hata veren dosyayı eklermisiniz.

 

[ADER_34]

Evren Bey hata veren dosya ve kodlarınızı denediğim dosya örnek dosyamın aynısı rar içinden çıkartıp dosyayı kapatıp açtım yine aynı satırda hata verdi.

 

[Orion1]

Evren Bey hata veren dosya ve kodlarınızı denediğim dosya örnek dosyamın aynısı rar içinden çıkartıp dosyayı kapatıp açtım yine aynı satırda hata verdi.

dosyayı link ile eklerdim.
Rardan çıkartın.
Gördüğünüz üzre çalışıyor.

DOSYAYI İNDİR

..

 

[ADER_34]

İşlem tamam Evren Bey çok teşekkür ederim sorun hücre biçiminden kaynaklanıyormuş bazı verileri silip değiştirip denedim kodlarda sorunyok sorunsuz çalışıyor. iyi geceler teşekkürler..

 

[Orion1]

İşlem tamam Evren Bey çok teşekkür ederim sorun hücre biçiminden kaynaklanıyormuş yani kodlarda değil iyi geceler teşekkürler..

Rica ederim.
İyi çalışmalar.

 

[ADER_34]

Selam hayırlı akşamlar arkadaşlar Evren Bey' in makro ile çözüm bulduğu dosyamda ilave olarak texboxlara girdiğim part no ve tarihe göre işlem yapmak istiyorum kodlara nasıl ilave yapmalıyım
kodlar:Sub aktartopla59()
On Error Resume Next
Dim sh As Worksheet, sat As Long, sonsat As Long, k As Range
Sheets("İNPUT RAPOR").Select
Application.ScreenUpdating = False
For Each sh In Worksheets
If sh.Name <> "İNPUT RAPOR" Then
sonsat = sh.Cells(Rows.Count, "A").End(xlUp).Row
For sat = 2 To sonsat
Set k = Range("A2:A" & Rows.Count).Find(sh.Cells(sat, "A").Value, , xlValues, xlWhole)
If Not k Is Nothing Then
sh.Cells(sat, "D").Value = sh.Cells(sat, "D").Value + k.Offset(0, 3).Value
End If
Next sat
End If
Next sh
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "VERİ GİRİŞİNİ KONTROL ET", 64
End Sub
teşekkürler kolay gelsin..