Sütunda Boş Olmayan Hücreleri Bulup, Hücrenin Satırındaki Verileri Silmek

[ckkckk]

Merhaba Arkadaşlar;

Hazırlamam gereken bir iş için çalışma sayfaları arası veri aktarımı yapacağım.

Ama öncelikle kopyaladığım ham veriyi taslağa uygun hale getirmek için işlemem gerekiyor.

Bunun için de A sütununda dolu olan hücreleri bulup, hücrenin satırındaki verileri silmem gerekmekte ve ben bunu bir türlü beceremedim.

Eklediğim iki ayrı Excel'de ham bilgi ve dönüştürmek istediğim şekilde el yordamıyla hazırladığım dosyaları bulabilirsiniz. Yardımlarınız çok ama çok önemlidir. :yardım:

 

[dEdE]

Merhaba,
Forumumuza hoşgeldiniz.
Dosyanız ilişiktedir.

Sub düzenle()
Application.ScreenUpdating = False
Columns("D:D").SpecialCells(xlCellTypeBlanks).Delete (3)
x = 2
For i = 2 To Range("A" & Rows.Count).End(3).Row
    If Cells(i, 1).Value <> "" Then
        Cells(i + 1, 1).Value = Cells(i, 1).Value
        Rows(i).Delete
        Range("A" & x & ":A" & i - 1).Merge
        x = i
    End If
Next
[A2].Value = [A1].Value
Rows(1).ClearContents
Range("A" & x & ":A" & Range("B" & Rows.Count).End(3).Row).Merge
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı", vbInformation, "dEdE " & Application.UserName & "'e Başarılar diler."
End Sub

 

[ckkckk]

Merhaba,
Forumumuza hoşgeldiniz.
Dosyanız ilişiktedir.

Sub düzenle()
Application.ScreenUpdating = False
Columns("D:D").SpecialCells(xlCellTypeBlanks).Delete (3)
x = 2
For i = 2 To Range("A" & Rows.Count).End(3).Row
    If Cells(i, 1).Value <> "" Then
        Cells(i + 1, 1).Value = Cells(i, 1).Value
        Rows(i).Delete
        Range("A" & x & ":A" & i - 1).Merge
        x = i
    End If
Next
[A2].Value = [A1].Value
Rows(1).ClearContents
Range("A" & x & ":A" & Range("B" & Rows.Count).End(3).Row).Merge
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı", vbInformation, "dEdE " & Application.UserName & "'e Başarılar diler."
End Sub

Hoşbulduk Sayın dEde;

Kod tek kelimeyle muazzam çalışıyor. Gerçekten nasıl teşekkür etsem bilemedim. Süper olmuş gerçekten elleriniz dert görmesin.

BÜYÜKSÜN dEdE