sutunların tek sutunda birleştirilmesi

[hakin]

Arkadaşlar ekli dosyayı inceleyebilirmisiniz.

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Option Explicit
 
Sub Birlestir()
Dim i, Kolon As Integer
Application.ScreenUpdating = False
Kolon = [IV2].End(1).Column
Range("B2:B65536").ClearContents
For i = 4 To Kolon
    Range(Cells(2, i), Cells(Cells(65536, i).End(3).Row, i)). _
    Copy Range("B" & [B65536].End(3).Row + 1)
Next i
Application.ScreenUpdating = True
MsgBox "Birleştirme Gerçekleştirilmiştir", vbInformation, "[URL="http://www.ewcel.web.tr/"]www.ewcel.web.tr[/URL]"
End Sub

.

 

[hamitcan]

Buda benden olsun.

Sub birlestir()
Dim arr()
Columns(2).Clear
    For i = 4 To 8
        For j = 2 To Cells(65536, i).End(3).Row
        c = c + 1
        ReDim Preserve arr(1 To c)
           arr(c) = Cells(j, i)
        Next
    Next
    Range("b1:b" & c) = WorksheetFunction.Transpose(arr)
End Sub