çoklu sütun değerlerini tek bir sütuna nasıl getirilir

[KMLZDMR]

Merhaba
çoklu sütun değerlerini tek bir sütuna nasıl getirilir. (excel 2003)
Ekli dosyada E1:K50 aralığındaki veri alanını esas alınmak üzere;
a) O sütununa "TÜR" P sütununa "TİP" gelmek üzere ekli dosyada P sütununa "TİP" manuel geldiği üzere sırasıyla TÜR ve Sayfa alanları formül ile nasıl getirilebilir?
b) U sütununa "TÜR" V sütununa "TİP" gelmek üzere ekli dosyada 6 sütundan oluşan "TİP" satırlara dağıtılarak tür ve sayfa alan değerleri formül ile nasıl getirilebilir?

lütfen yardımcı olabilir misiniz?

 

[Ziynettin]

Merhaba,

[O:Q] tablonuz için.

Sub test_tablo1()
a = Range("E1:K" & Cells(Rows.Count, 5).End(3).Row).Value
    ReDim b(1 To UBound(a) * 6, 1 To 3)
    For j = 1 To 6
        sut = j + 1
        For i = 2 To UBound(a)
            say = say + 1
            b(say, 1) = a(i, 1)
            b(say, 2) = a(1, sut)
            b(say, 3) = a(i, sut)
        Next i
    Next j
Range("O2:Q" & Rows.Count).ClearContents
If say > 0 Then
    [O2].Resize(say, 3) = b
    MsgBox "İşlem tamam", vbInformation
Else
    MsgBox "İşlem yok", vbCritical
End If
End Sub

[U:W] tablonuz için.

Sub test_tablo2()
Set d = CreateObject("scripting.dictionary")
a = Range("E1:K" & Cells(Rows.Count, 5).End(3).Row).Value
    For i = 1 To UBound(a): d(a(i, 1)) = "": Next i
    ReDim b(1 To UBound(a) * 6, 1 To 3)
        For Each v In d.keys
            For i = 2 To UBound(a)
                For j = 1 To 6
                    sut = j + 1
                    If a(i, 1) = v Then
                        say = say + 1
                        b(say, 1) = a(i, 1)
                        b(say, 2) = a(1, sut)
                        b(say, 3) = a(i, sut)
                    End If
                Next j
            Next i
        Next v
    Range("U2:W" & Rows.Count).ClearContents
    If say > 0 Then
        [U2].Resize(say, 3) = b
        MsgBox "İşlem tamam", vbInformation
    Else
        MsgBox "İşlem yok", vbCritical
    End If
End Sub

 

[KMLZDMR]

Sayın Ziynettin teşekkür ederim.
Formülle yapmaya ihtiyacım var...
Formülle yapacak arkadaşlardan destek bekliyorum..