Veri olan sütunları alt alta alma

[Bursat]

Merhaba,

Her sütunda alt alta 17 veri bulunuyor. Bu verileri 17, 17 alt alta almak istiyorum. Sütun sayısı 10.000 (ANL Sütununa kadar gidiyor)

Umarım anlata bilmişimdir.

 

[Ömer]

Merhaba,

Module kopyalayıp çalıştırın.
Sayfa1 deki verileri istediğiniz formatta Sayfa2 de listeler.

Sub Donustur()
 
    Dim S1 As Worksheet, sat As Long, i As Long, alan As String
 
    Set S1 = Sheets("[COLOR=red]Sayfa1[/COLOR]")
 
    Application.ScreenUpdating = False
 
    Sheets("[COLOR=blue]Sayfa2[/COLOR]").Select
    Range("A:A").Clear
 
    sat = 1
    For i = 1 To S1.Cells.Find("*", , , , xlByColumns, xlPrevious).Column
        alan = S1.Cells(1, i).Resize(17, 1).Address(external:=True)
        If WorksheetFunction.CountA(Range(alan)) > 0 Then
            Range(alan).Copy Cells(sat, "A")
            sat = sat + 17
        End If
    Next i
 
    Application.ScreenUpdating = True
 
End Sub

.

 

[Bursat]

Ömer bey, Allah bin kez razı olsun beni büyük dertten kurtardınız. Çok teşekkür ederim.

 

[Ömer]

Rica ederim. Allah hepimizden razı olsun.