Satırı parçalayarak yeni satırlar yaratma

[johnnash]

Merhaba,

Ekteki ilk tabloyu ikinci tablo şekline makro ile dönüşterebilir miyim? Bu sorunun zorluk derecesi nedir? Yardımcı olur musunuz?

 

[Necdet]

Merhaba,

Kodları inceleyiniz.

Sub Duzenle()
    
    Dim i           As Long, _
        j           As Long, _
        k           As Integer, _
        SonKolon    As Integer, _
        s1          As Worksheet, _
        s2          As Worksheet
    
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    
    Application.ScreenUpdating = False
    
    SonKolon = s1.Cells(1, Columns.Count).End(1).Column
    
    j = s2.Cells(Rows.Count, "A").End(3).Row
    
    s2.Range("A1:C" & j).ClearContents
    s1.Range("A1:C1").Copy s2.Range("A1")
    
    j = 1
    
    For i = 2 To s1.Cells(Rows.Count, "A").End(3).Row
        For k = 2 To SonKolon Step 2
            If Not s1.Cells(i, k) = "" Then
                j = j + 1
                s1.Range("A" & i).Copy s2.Cells(j, 1)
                s1.Range(s1.Cells(i, k), s1.Cells(i, k + 1)).Copy s2.Cells(j, 2)
            End If
        Next k
    Next i
    
    s2.Select
    
    MsgBox "İşlem Tamamlanmıştır....", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    Application.ScreenUpdating = True
    
End Sub

 

[assenucler]

Teşekkürler üstadım...

 

[johnnash]

Necdet Bey,

Kısa sürede doğru şekilde sorumu yanıtladınız. Çok teşekkür ederim.

 

[Necdet]

Teşekkürler üstadım...

Necdet Bey,

Kısa sürede doğru şekilde sorumu yanıtladınız. Çok teşekkür ederim.

Güle güle kullanınız.