Sütunları satıra aktarma mumkunmu acaba

[osmanucel]

Elımdekı dosyada sutunlara yazdıklarımısatırlara aktarmak ısdıyorum yardımcı olursanız sevınırım

 

[Mustafa MUTLU]

Sütunu Kopyala
Bir Hücrede sağ tıkla
özel Yapıştır
İşlemi Tersine çevir

İşini Halleder ?..

 

[Necdet]

Merhaba,

Tüm değerleri aktaracaksanız aşağıdaki kodları kullanabilirsiniz.

Sub Aktar()
    
    Dim i As Long
    Dim sv As Worksheet
    Set sv = Sheets("VERİ TABANI")
    
    i = sv.Cells(Rows.Count, "B").End(3).Row + 1
    Application.ScreenUpdating = False
    
    Range("D5:D18").Copy
    sv.Range("B" & i).PasteSpecial _
        Paste:=xlPasteAll, _
        Operation:=xlNone, _
        SkipBlanks:=False, _
        Transpose:=True
        
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
    
End Sub

 

[Mahir64]

Merhaba,

Yeni kayıtlar alt alta mı aktarılacak?

 

[osmanucel]

cok sahane sagolun emeğinize saglık

 

[osmanucel]

yanyana
aslında
f5,f6,f7,f8,f9,f13,f14,f15,f17bı satıra
f5,f6,f12,f13,f14f15,f18bı alt satıra bole devam edıp gıdecek
ayrıca
kayıtdedıp f sutununu sılse
guzel olurdu

 

[osmanucel]

HOCAM VERDIGINIZ KODU DUZENLEYEREK YAPTIM SANIRIM

Sub Aktar()

Dim i As Long
Dim sv As Worksheet
Set sv = Sheets("VERİ TABANI")

i = sv.Cells(Rows.Count, "B").End(3).Row + 1
Application.ScreenUpdating = False

Range("F5,F6,F7,F8,F9,F13,F14,F15,F17").Copy
sv.Range("B" & i).PasteSpecial _
Paste:=xlPasteAll, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=True

i = sv.Cells(Rows.Count, "B").End(3).Row + 1
Application.ScreenUpdating = False

Range("F5,F6,F10,F11,F12,F13,F14,F16,F18").Copy
sv.Range("B" & i).PasteSpecial _
Paste:=xlPasteAll, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=True

With Application
.CutCopyMode = False
.ScreenUpdating = True
End With

End Sub

 

[Necdet]

Merhaba,

Kodda tekrar oluşmuş, aşağıdaki gibi deneyiniz.

Sub Aktar()
    
    Dim i As Long
    Dim sv As Worksheet
    Set sv = Sheets("VERİ TABANI")
    
    i = sv.Cells(Rows.Count, "B").End(3).Row + 1
    Application.ScreenUpdating = False
    
    Range("F5,F6,F7,F8,F9,F13,F14,F15,F17").Copy
    sv.Range("B" & i).PasteSpecial _
        Paste:=xlPasteAll, _
        Operation:=xlNone, _
        SkipBlanks:=False, _
        Transpose:=True
    
End Sub

 

[osmanucel]

Hocam burda hem alıs hemde satış olacak
ıkısı ayrı ayrı satıra ıslyecek
duzenledıgım kodda
oluyor
o sekılde kaydedıyor
sızın bu son verdıgınız kodda
sadece alıs kaydedıyor

 

[Necdet]

Hocam burda hem alıs hemde satış olacak
ıkısı ayrı ayrı satıra ıslyecek
duzenledıgım kodda
oluyor
o sekılde kaydedıyor
sızın bu son verdıgınız kodda
sadece alıs kaydedıyor

hmm dikkat etmemişim o zaman, haklısınızdır.

 

[osmanucel]

Cok sagolun hocam
bu sekılde
cok sahane oldu cok sagolun
hocam
dosyanın tamamını yuklesem
yardımcı olabılırmısınız acaba