En son dolu hücreyi bulup formül kopyalama

[patdizz]

Merhaba arkadaşlar.
Soruyu örnek dosyaya yazdım.
Şimdiden teşekkür ederim.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz. 2007 ve sonraki versiyonlarda çalışır. Daha önceki versiyonlarda çalışması için kırmızı renkli değerleri 65536 olarak değiştirmelisiniz.

Option Explicit
 
Sub FORMÜLLERİ_KOPYALA()
    Dim Satır_1 As Long, Satır_2 As Long, Satır_3 As Long, Son_Satır As Long
    
    Satır_1 = Range("E[COLOR=red]1048576[/COLOR]").End(3).Row
    Satır_2 = Range("F[COLOR=red]1048576[/COLOR]").End(3).Row
    Satır_3 = Range("I[COLOR=red]1048576[/COLOR]").End(3).Row
    
    Son_Satır = WorksheetFunction.Max(Satır_1, Satır_2, Satır_3)
    
    If Son_Satır > 4 Then
        Range("C4:D4").AutoFill Destination:=Range("C4:D" & Son_Satır), Type:=xlFillDefault
        Range("G4:H4").AutoFill Destination:=Range("G4:H" & Son_Satır), Type:=xlFillDefault
        Range("J4").AutoFill Destination:=Range("J4:J" & Son_Satır), Type:=xlFillDefault
    End If
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[patdizz]

Eklediğim örnek dosya, çok sayfalı gerçek dosyanın basitleştirilmiş bir biçimiydi. Formüllü sütunlar her sayfada farklı olduğundan hangi sütunların kopyalanacağı makro ile bulunmalı.

 

[hamitcan]

Bir tane de benden

Sub SadeceFormulleriKopyala()
    a = Split(ActiveSheet.UsedRange.Address, "$")(4)
    For Each hcr In Range("c4:j" & a)
        If hcr.HasFormula Then
            hcr.Copy
            Range(Cells(5, hcr.Column), Cells(a, hcr.Column)).PasteSpecial (xlPasteFormulas)
        End If
    Next
    Application.CutCopyMode = False
End Sub

 

[patdizz]

Sayın hamitcan, sanırım tam olarak aradığım buydu.. Şimdilik bir problem gözükmüyor, elinize sağlık çok teşekkür ederim.

 

[halit3]

Hamit Bey son satırla ilgili

ActiveSheet.UsedRange.Address

bu kod bazen hata veriyor aşağıdaki kotda hiç hata görmedim.

sonsatır = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

konu ile ilgili aşağıdaki linkde 8. mesajda bir dosya var


http://www.excel.web.tr/f48/son-dolu-sutunu-bulma-t86295.html

 

[hamitcan]

Evet haklısnız Halit bey, boşlukları yada daha önce işlem görmüş ve silinmiş bazı hücreleri de dikkate alıyor, bu durumu engellemek için kodu, belirttiğiniz şekilde düzenleyebiliriz.

 

[patdizz]

Sayın hamitcan'ın çözümü deneme dosyasında çalışmışken, makroyu büyük dosyamın modülüne kaydedip gerekli düzenlemeleri yaptıktan sonra çalıştırdığımda pastespecial satırında hep aşağıdaki hatayı verdi :

Run-time error 91
object variable or With block variable not set

Yani makroyu asıl dosyada çalıştıramadım. Usedrange formülü yerine sayın halit3'ün önerdiği satırı yazdığımda ise bu sefer önceki hata veren satıra ulaşamadan bu satırda aynı hatayı verdi.. SpecialCells kullanıp, bütün sütunlarda for-next döngüsü ile dolu hücreleri buldurup satır sayısı en büyük olanı almak son dolu satırı bulmak için bir çözüm olabilir diye düşünüyorum. Deneyeceğim. Run-time probleminin çözümü için ise set hcr = cells (A5) ve bir for-next denedim ama olmadı malesef.

 

[hamitcan]

Dosyanızı ekleyin, belki farklı bir çözüm üretebiliriz.

 

[patdizz]

Sn hamitcan,
Problemi sizin çözümünüzü temel alarak başka bir yolla çözdüm, yardımcı olan herkese çok teşekkür ederim. Tek pürüz beklediğimden yavaş çalışması ama hiç önemli değil. İşte problemsiz çalışan kod:

Sub tablo_formül()
   
    başsatır = 5
    sonsatır = Split(ActiveSheet.UsedRange.Address, "$")(4)
        
    For Each hcr In ActiveSheet.Range(başsatır & ":" & başsatır)
        If hcr.HasFormula Then
            hcr.Copy
            i = hcr.Column
            Range(ActiveSheet.cells(başsatır + 1, i), ActiveSheet.cells(sonsatır, i)).Select
            Selection.PasteSpecial (xlPasteAll)
        End If
    Next
    
    Application.CutCopyMode = False
        
End Sub

 

[Korhan Ayhan]

Selamlar,

Formüllü hücreyi kopyalamak yerine AutoFill (Otomatik Doldur) yöntemini kullanırsanız kod daha hızlı çalışır.

 

[patdizz]

Denedim yine hata verdi. En iyisi geç olsun güç olmasın hocam Teşekkürler

 

[Korhan Ayhan]

Selamlar,

Sn. patdizz,

Dosyanızın hata veren bölümünü içeren küçük bir örnek dosya eklerseniz kodu geliştirip hızlandırma şansımız olabilir. Bu devirde zaman çok kıymetlidir. Değerini bilmek gerekir.