Boş Hücrenin Sağındaki Hücreyi Seç, Kes, Yapıştır

[brhmbl]

merhaba değerli excel guruları,

makro öğrenmeye çalışıyorum ve kendi çapımda küçük bir şeyler yapmaya başladım. çıktığım bu uzun yolculukta şimdiye kadar olduğu gibi yine siz değerli dostların fikirlerine ihtiyaç duyuyorum.

ekli dosyada talebimi tam olarak anlatabildiğimi sanıyorum. yardımcı olabilirseniz sevinirim.

 

[Necdet]

Merhaba,

Aşağıdaki kodları dener misiniz?

Sub Makro1()

    Dim Sat As Long
    Dim Hcr As Range
    Dim i   As Integer
    
    Sat = Cells.Find("*", , , , xlByRows, xlPrevious).Row
    
    For i = 1 To 2
        For Each Hcr In Range("A2:D" & Sat).SpecialCells(xlCellTypeBlanks)
            Hcr = Hcr.Offset(0, 2)
            Hcr.Offset(0, 2).ClearContents
        Next Hcr
    Next i
    
End Sub

 

[brhmbl]

Merhaba,

Aşağıdaki kodları dener misiniz?

Sub Makro1()

    Dim Sat As Long
    Dim Hcr As Range
    Dim i   As Integer
    
    Sat = Cells.Find("*", , , , xlByRows, xlPrevious).Row
    
    For i = 1 To 2
        For Each Hcr In Range("A2:D" & Sat).SpecialCells(xlCellTypeBlanks)
            Hcr = Hcr.Offset(0, 2)
            Hcr.Offset(0, 2).ClearContents
        Next Hcr
    Next i
    
End Sub

Necdet Bey elinize aklınıza sağlık, çok süper. tam işime yarayan şekilde olmuş.

Ben de acemiliğimden ötürü işi biraz uzun tutarak aşağıdaki gibi bir makro oluşturabildim. bende ki sorun: üst üste iki boş hücrenin denk gelebileceğinden ötürü makroyu 2 kere çalıştırmak gerekiyor

Sub boşu_bul()
Dim i As Integer
i = Empty
For i = Range("c10").End(xlToRight).Row To 1 Step -1
    If Cells(i, "c") = "" Then
        Cells(i, "c").Select
        ActiveCell.Offset(0, 2).Select
        Selection.Copy
        ActiveCell.Offset(0, -2).Select
        ActiveSheet.Paste
        ActiveCell.Offset(0, 2).Select
        ActiveCell.ClearContents
    End If
Next i

For i = Range("d10").End(xlToRight).Row To 1 Step -1
If Cells(i, "d") = "" Then
        Cells(i, "d").Select
        ActiveCell.Offset(0, 2).Select
        Selection.Copy
        ActiveCell.Offset(0, -2).Select
        ActiveSheet.Paste
        ActiveCell.Offset(0, 2).Select
        ActiveCell.ClearContents
    End If
Next i

For i = Range("e10").End(xlToRight).Row To 1 Step -1
If Cells(i, "e") = "" Then
        Cells(i, "e").Select
        ActiveCell.Offset(0, 2).Select
        Selection.Copy
        ActiveCell.Offset(0, -2).Select
        ActiveSheet.Paste
        ActiveCell.Offset(0, 2).Select
        ActiveCell.ClearContents
    End If
Next i

For i = Range("f10").End(xlToRight).Row To 1 Step -1
If Cells(i, "f") = "" Then
        Cells(i, "f").Select
        ActiveCell.Offset(0, 2).Select
        Selection.Copy
        ActiveCell.Offset(0, -2).Select
        ActiveSheet.Paste
        ActiveCell.Offset(0, 2).Select
        ActiveCell.ClearContents
    End If
Next i

End Sub

 

[brhmbl]

Merhaba,

Aşağıdaki kodları dener misiniz?

Sub Makro1()

    Dim Sat As Long
    Dim Hcr As Range
    Dim i   As Integer
    
    Sat = Cells.Find("*", , , , xlByRows, xlPrevious).Row
    
    For i = 1 To 2
        For Each Hcr In Range("A2:D" & Sat).SpecialCells(xlCellTypeBlanks)
            Hcr = Hcr.Offset(0, 2)
            Hcr.Offset(0, 2).ClearContents
        Next Hcr
    Next i
    
End Sub

Necdet Bey merhaba, sizi yeniden rahatsız ediyorum kusura bakmayın. ama sanırım küçük bir sorun var.

D sütunundaki boşlukları F sütunu ile dolduruyor ama F sütunu temizlemiyor. bunu nasıl düzenleyebiliriz.

Not: ben a2:d yerine c2:f yaptım kodu.