Option Explicit
Sub sütunlaştır()
Dim ts, kaplan
Dim a, b, c, d, e, f, g, h, ı
a = 2: b = 2: c = 2: d = 2: e = 2
f = 2: g = 2: h = 2: ı = 2
kaplan = MsgBox("Verileri Çıkartıyorum", vbYesNo, "Onay")
If kaplan = vbNo Then Exit Sub
Sheets("Sayfa2").Range("A:I").ClearContents
For ts = 1 To Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row
If InStr(1, Sheets("Sayfa1").Cells(ts, "A"), "SEGMENT-", _
vbTextCompare) Then
Sheets("Sayfa2").Cells(a, "A") = Sheets("Sayfa1").Cells(ts, "A")
a = a + 1
ElseIf InStr(1, Sheets("Sayfa1").Cells(ts, "A"), "INDEX", _
vbTextCompare) Then
Sheets("Sayfa2").Cells(b, "B") = Sheets("Sayfa1").Cells(ts, "A")
b = b + 1
ElseIf InStr(1, Sheets("Sayfa1").Cells(ts, "A"), "CODE -1-", _
vbTextCompare) Then
Sheets("Sayfa2").Cells(c, "C") = Sheets("Sayfa1").Cells(ts, "A")
c = c + 1
ElseIf InStr(1, Sheets("Sayfa1").Cells(ts, "A"), "CODE -2-", _
vbTextCompare) Then
Sheets("Sayfa2").Cells(d, "D") = Sheets("Sayfa1").Cells(ts, "A")
d = d + 1
ElseIf InStr(1, Sheets("Sayfa1").Cells(ts, "A"), "CODE -3-", _
vbTextCompare) Then
Sheets("Sayfa2").Cells(e, "E") = Sheets("Sayfa1").Cells(ts, "A")
e = e + 1
ElseIf InStr(1, Sheets("Sayfa1").Cells(ts, "A"), "IDENTIFICATION", _
vbTextCompare) Then
Sheets("Sayfa2").Cells(f, "F") = Sheets("Sayfa1").Cells(ts, "A")
f = f + 1
ElseIf InStr(1, Sheets("Sayfa1").Cells(ts, "A"), "CODE -4-", _
vbTextCompare) Then
Sheets("Sayfa2").Cells(g, "G") = Sheets("Sayfa1").Cells(ts, "A")
g = g + 1
ElseIf InStr(1, Sheets("Sayfa1").Cells(ts, "A"), "CODE -5-", _
vbTextCompare) Then
Sheets("Sayfa2").Cells(h, "H") = Sheets("Sayfa1").Cells(ts, "A")
h = h + 1
ElseIf InStr(1, Sheets("Sayfa1").Cells(ts, "A"), "NUMBER", _
vbTextCompare) Then
Sheets("Sayfa2").Cells(ı, "I") = Sheets("Sayfa1").Cells(ts, "A")
ı = ı + 1
End If
Next
MsgBox "Verileri Çıkarttım", vbInformation, "Bitiş"
End Sub