cell data kaydirma

[lapot]

Arkadaslar
ekdeki dosyadaki kirmizi isaretli kodlari yandaki cellerre macro ile nasil kaydirabilirim?
bende bir formul var sadece bir celle kaydiriyor.

For i = 1 To 65000
If Cells(i, 1) = "Case Type" Then
Cells(i, 1).Offset(1, 0).Value = Cells(i, 1).Offset(0, 1).Value
Cells(i, 1).Offset(0, 1).ClearContents
End If
Next
End Sub

ben her kodu "Totals for case type" e kadar kaydirmak istiyorum
yardimci olabilirmisiniz, cok tesekkurler.

 

[Korhan Ayhan]

Selamlar,

Örnek bir dosya eklermisiniz.

 

[lapot]

arkadasim eklenmis dosya var.

 

[Korhan Ayhan]

Selamlar,

Excel dosyanızı kastetmiştim.

 

[lapot]

su an excel dosyasini ekledim. yardim ederseniz sevinirim saygilar

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub DOLDUR()
    On Error GoTo Son
    For Each ALAN In Range("A4:A" & [A65536].End(3).Row).SpecialCells(xlCellTypeBlanks).Areas
    ADRES = ALAN.Address(0, 0)
    Range(ADRES).Value = Range(Replace(Mid(ALAN.Offset(-1, 1).Address(0, 0), 1, 3), ":", "")).Value
    Next
    MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
    Exit Sub
Son:
    MsgBox "BOŞ HÜCRE BULUNAMAMIŞTIR.", vbInformation
End Sub

 

[lapot]

cok tessekkurler arkadasim. harikasin fakat bos hucre (A:A) de bende tarihler var 01-Jan-06 formatinda. onlari temizlemem lagzim senin macronun calismasi icin.
yinede tesekkurler

 

[lapot]

Arkadsim sample2 dosyasini ekledim ve stun A daki tarihleri kaldiramiyorum senin formulunu claistirmak icin cunku stun adaki tarih yerlerinin bos olmasi lagzim. nasil tarihleri temizleriz?

 

[Korhan Ayhan]

Selamlar,

Sorunuzu sorarken bu ayrıntıyı belirtseydiniz cevabınızı ona göre düzenleyebilirdim. Vermiş olduğum cevaptaki kod eklediğiniz dosyaya göre hazırlanmıştır.

cok tessekkurler arkadasim. harikasin fakat bos hucre (A:A) de bende tarihler var 01-Jan-06 formatinda. onlari temizlemem lagzim senin macronun calismasi icin.
yinede tesekkurler

 

[lapot]

kusura bakmayin, tarihlerin bukadar ayrinti olacagini dusnmemistim. yinede tesekkurler.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kod yeni dosya formatınıza göre hazırlanmıştır. Umarım faydası olur.

Sub DOLDUR()
    For X = 4 To [A65536].End(3).Row
    If Cells(X, 1) = "Case type" Then Kriter = Cells(X, 2)
    If IsDate(Cells(X, 1)) = True Then Cells(X, 1) = Kriter
    Next
    MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub

 

[lapot]

Arkadasim sana ne kadar tessekur etsem azdir, you are a star! cok tesekkurker harcadigin zaman icin. simdi istedigim oldu.