alt alta sıralama

[legendary_55]

arkadaşlar merhaba,
Linkte bulunan excell için yardıma ihtiyacım var, yapmak istediğim, belirli sayıdaki sütünu, farklı bir sekmede 2 sütuna indirmek.

örneğin olmasını istediğim sıralama;
A2 B2
A3 B3
A4 B4
.
.
.
.
A2 C2
A3 C3
A4 C4

https://1drv.ms/x/s!Ak0YIHeIa01GglZ8ViK59cX_296d

 

[Ömer BARAN]

Merhaba, foruma hoşgeldiniz.

1487984 adet formül hesaplatmak yerine makro ile çözüm önerisinde bulunacağım.
-- Asıl belgeniz dışındaki Excel belgelerini kapatıp işlem yapılacak belgeyi açın,
-- alt taraftan Sayfa4 adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- açılan VBA ekranında sağdaki boş alana aşağıdaki kod'u yapıştırın,
-- Ok tuşlarını kullanarak imlecin Sub IKI_SUTUN() satırına gelmesini sağlayın,
-- F5 tuşuna basın ve işlem tamamlanıncaya kadar birkaç saniye bekleyin.
.

[B][COLOR="Blue"]Sub IKI_SUTUN()[/COLOR][/B]
Set ana = Sheets("[COLOR="Red"]Sayfa4[/COLOR]")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

    isim = "YENİ_" & Sheets.Count
    sonsat = ana.Cells(Rows.Count, "A").End(3).Row
    ana.Activate
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = isim
For sut = 2 To ana.Cells(1, Columns.Count).End(1).Column
    sat = Sheets(isim).Cells(Rows.Count, 1).End(3).Row + 1
        ana.Range("A2:A" & sonsat).Copy Sheets(isim).Cells(sat, 1)
    ana.Range(Cells(2, sut), Cells(sonsat, sut)).Copy Sheets(isim).Cells(sat, 2)
Next

Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Sheets(isim).Activate
MsgBox "İşlem tamamlandı.", vbInformation, "..::.. ÖMER BARAN ..::.."
Application.ScreenUpdating = True

[B]End Sub[/B]

 

[legendary_55]

Çok Teşekkür Ederim, beni büyük bir yükten kurtardınız.

 

[Murat OSMA]

Ömer Bey,

Aklınızda bulunsun; sayfalar arası işlemlerde Range ve Cells öncesinde sayfa adı mutlaka belirtilmelidir, belirtilmez ise hatalara sebep olabilir.


Saygılar​