DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub deneme()
Sheets.Add
x = 1
s = 1
For Each bol In Sayfa1.Range("a1").CurrentRegion
dizi = VBA.Split(bol, Chr(10))
For Each deg In dizi
Data = VBA.Split(deg, "#")
For Each i In Data
Cells(x, s) = i
s = s + 1
Next i
s = 1
x = x + 1
Next deg
Next bol
End Sub
Function Ayır_Damga(i As String, j As Integer)
metin = Split(i, Chr(10))
Ayır_Damga = metin(j - 1)
End FunctionHocam ne kadar düşünceli bir insansınız. Hem satırlara hem de sütunlara bölüyor. Körün istediği bir göz Allah verdi iki göz
Çok sade ve işlevsel. Tekrar teşekkür ediyorum. Bilginize ve emeğinize sağlık.
Ben teşekkür ederim,sağ olun.Hocam ne kadar düşünceli bir insansınız. Hem satırlara hem de sütunlara bölüyor. Körün istediği bir göz Allah verdi iki göz
Sub Ayir()
Dim Kol As Integer, _
k As Integer, _
n As Integer, _
j() As Long, _
i As Long, _
Sat As Long, _
s, _
sh1 As Worksheet, _
sh2 As Worksheet
Set sh1 = Sheets("Sayfa1")
Set sh2 = Sheets("Sayfa2")
sh1.Select
sh2.Cells.ClearContents
Kol = Cells(1, Columns.Count).End(1).Column
ReDim j(1 To Kol)
Sat = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
On Error Resume Next
For i = 1 To Sat
For k = 1 To Kol
If Not Cells(i, k) = "" Then
s = Split(Cells(i, k), Chr(10))
For n = 0 To UBound(s)
j(k) = j(k) + 1
sh2.Cells(j(k), k) = s(n)
Next n
End If
Next k
Next i
MsgBox "İşlem Tamamdır..."
sh2.Select
End Sub
