Çözüldü Boş Satırları Bir Üstteki Satır ile Doldurma

[Hattushil]

Aşağıdaki makroyu buldum, çalışıyor fakat sadece A sütununda çalışıyor, makro kodları arasında sütun ayarını nasıl yapabilirim?

Örneğin;
A, B, C, D ve E sütunlarını doldurmak istiyorum.

Sub doldur()
Dim i, son As Long: son = Cells(Rows.Count, 2).End(xlUp).Row
For i = 1 To son
If Cells(i, 1) = "" Then
Cells(i, 1).Value = Cells(i - 1, 1).Value
End If
Next i
End Sub

 

[RBozkurt]

**Manuel
İlgili sütunları seçin,
F5 yapın ve BOŞ olanları seçin
= yapın ve aktif olan hücrenin bir üst hücresini tıklayın,
Ctrl + Enter basın.

 

[Hattushil]

Hocam makro ile yapsam daha kolay olur sanırım,
Zira dosyalarım baya fazla satır içeriyor.

 

[Necdet]

Hocam makro ile yapsam daha kolay olur sanırım,
Zira dosyalarım baya fazla satır içeriyor.

Merhaba,
Sayın RBozkurt'un önerisini makro kaydet ile yaparak, kodlara ulaşabilirsiniz.

 

[RBozkurt]

Merhaba, deneyin.

Sub YukaridakiDegeriYaz()
    Dim sonSatir As Long
    Dim i As Long
    
    sonSatir = Cells(Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To sonSatir
        If Cells(i, "A").Value = "" Then
            Cells(i, "A").Value = Cells(i - 1, "A").Value
        End If
        
        If Cells(i, "B").Value = "" Then
            Cells(i, "B").Value = Cells(i - 1, "B").Value
        End If
        
        If Cells(i, "C").Value = "" Then
            Cells(i, "C").Value = Cells(i - 1, "C").Value
        End If
        
        If Cells(i, "D").Value = "" Then
            Cells(i, "D").Value = Cells(i - 1, "D").Value
        End If
        
        If Cells(i, "E").Value = "" Then
            Cells(i, "E").Value = Cells(i - 1, "E").Value
        End If
    Next i
End Sub

 

[Hattushil]

teşekkür ederim.

 

[RBozkurt]

Rica ederim kolay gelsin.

 

[Korhan Ayhan]

Altenatif,

Döngü kullanılmadığı için biraz daha iyi performans verecektir.

Option Explicit

Sub Fill_Blanks_Cells()
    Dim My_Area As Range
    
    On Error Resume Next
    Set My_Area = Nothing
    Set My_Area = Range("A2:E" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    
    If Not My_Area Is Nothing Then
        With My_Area
            .FormulaR1C1 = "=R[-1]C"
            .Value = .Value
        End With
        MsgBox "Tespit edilen boş hücreler üstteki hücre ile doldurulmuştur.", vbInformation
    Else
        MsgBox "Boş hücre bulunamadı!", vbExclamation
    End If
End Sub