Sütunlarda boşlulu olan veriyi tablo haline getirmek

[hsayar]

http://www.excel.web.tr/attachment.php?attachmentid=105082&d=1298283929
Yukarıdaki dosyada veriler ABC sütunlarında aşağıdaki şekilde yer almaktadır.

[FONT=Courier New]ABD 
           ALABAMA
                          AUBURN
                          BIRMINGHAM

TÜRKİYE
          EYALET YOK  
                          ADANA
                          ADIYAMAN
    
[/FONT]

Aşağıdaki şekilde nasıl çevirebiliriz?

[FONT=Courier New]
ABD        [/FONT][FONT=Courier New]ALABAMA        [/FONT][FONT=Courier New]AUBURN
[/FONT][FONT=Courier New] ABD        ALABAMA        [/FONT][FONT=Courier New]BIRMINGHAM[/FONT][FONT=Courier New]  
TÜRKİYE    EYALET YOK     [/FONT][FONT=Courier New]ADANA
[/FONT][FONT=Courier New]TÜRKİYE    EYALET YOK     [/FONT][FONT=Courier New]ADIYAMAN[/FONT][FONT=Courier New]                          
[/FONT]

 

[Korhan Ayhan]

Selamlar,

Verilerinizin yedeğini alarak aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub VERİLERİ_DÜZENLE()
    Dim X As Long, EYALET As String
    
    On Error Resume Next
    Columns("C:C").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
    Columns("A:A").SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    Range("A1:A" & Range("A65536").End(3).Row).Value = Range("A1:A" & Range("A65536").End(3).Row).Value
    On Error GoTo 0
    
    For X = 1 To Range("A65536").End(3).Row
        If Cells(X, "B") = "" And EYALET = "" Then
            Cells(X, "B") = "Eyalet yok"
            EYALET = "Eyalet yok"
        ElseIf Cells(X, "B") <> "" And Cells(X, "B") <> "Bir eyalet seçiniz" Then
            EYALET = Cells(X, "B")
        ElseIf Cells(X, "B") = "" And EYALET <> "" Then
            Cells(X, "B") = EYALET
        ElseIf Cells(X, "B") = "Bir eyalet seçiniz" Then
            Cells(X, "B") = EYALET
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[hsayar]

İlginize teşekkür ederim ancak olmadı hocam, örnek dosya ilk mesajda ilk satırdaki linktedir.

 

[hsayar]

İlginize teşekkür ederim ancak olmadı hocam, örnek dosya ilk mesajda ilk satırdaki linktedir.

güncel ... ...

 

[Husgvarna]

Merhaba.
Aşağıdaki dosyayı inceleyin.