Makro ile sütunu satıra çevirme.

[matit35]

Örnekte belirttiğim gibi sütunu satıra dönüştürmek mümkün mü?
Konularda aradım ama bu şekilde örneğe rastlayamadım.
Yardımlarınız için şimdiden teşekkür ederim.

 

[usubaykan]

Merhaba;

Aşağıdaki kodu dener misiniz?

Option Explicit
Sub satırı_sütuna_çevir()
Dim u As Long
    For u = 6 To Range("C65536").End(3).Row
    Cells(6, u + 2) = Cells(u, 3)
    Cells(7, u + 2) = Cells(u, 4)
    Next
End Sub

 

[matit35]

teşekkür ederim cevap için.
denedim ama çalıştıramadım.
bu veriyi yapıştırdığımda mı çalışacak?

 

[usubaykan]

Merhaba;

Tekrar denedim eklediğiniz örnek dosya da çalışıyor. Verileri değiştirip deneyiniz.

 

[matit35]

Bunu sayfa 1 in kod bölümüne yazacağım değil mi?

 

[usubaykan]

Hayır Modul içine yazmalısınız.
Alt+F11 / Sayfa1 üzerinde sağ klik insert / Modul
yolunu izleyerek modul eklemelisiniz. Modul eklemeyle ilgili arama yapınız.

 

[matit35]

bakın örnekte ekledim
değiştirsem de makro çalışmıyor.
en azından nerede hata yapıyorum söyleyebilir misiniz.

 

[Korhan Ayhan]

Selamlar,

Sn. matit35,

Size önerilen kod otomatik çalışmaz. Bir butona bağlayıp kullanmalısınız. Verilerinizi kopyala-yapıştır yaptıktan sonra butona tıklamalısınız.

Eğer buton kullanmak istemiyorum diyorsanız ilgili sayfanın kod bölümüne aşağıdaki kodu uygulayın.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, Range("C6:D65536")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    Range("H6:IV7").ClearContents
    Range("C6:D" & Range("C65536").End(3).Row).Copy
    Range("H6").PasteSpecial Paste:=xlPasteValues, Transpose:=True
    Application.CutCopyMode = False
    Range("C6").Select
    Application.EnableEvents = True
    Exit Sub
Son:
    Application.CutCopyMode = False
    Application.EnableEvents = True
    MsgBox Err.Description
End Sub

 

[matit35]

çok teşekkür ederim tam aradığım buydu. çok uzun zamandır arıyordum ve sanırım tam olarak anlatamıyordum.
biraz daha ileri giderek bir soru daha sormak istiyorum. tam tersini yapacak olsak, yani sağ taraftaki satırı sütuna dönüştürmek istesek, kodu nasıl değiştirmeliyiz?
şimdiden çok teşekkür ederim.

 

[Korhan Ayhan]

Selamlar,

Aslında sizde verdiğim koda bakarak yeni istediğiniz kodu düzenleyebilirdiniz. Aşağıdaki şekilde deneyin.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, Range("H6:IV7")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    Range("C6:D65536").ClearContents
    Range("H6:IV7").Copy
    Range("C6").PasteSpecial Paste:=xlPasteValues, Transpose:=True
    Application.CutCopyMode = False
    Range("H6").Select
    Application.EnableEvents = True
    Exit Sub
Son:
    Application.CutCopyMode = False
    Application.EnableEvents = True
    MsgBox Err.Description
End Sub

 

[matit35]

aslında ben de ona çalışıyordum şu anda.
çok teşekkür ederim.
çok faydalı oldu. emeğinize sağlık

 

[matit35]

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, Range("C665536")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Range("H6:IV7").ClearContents
Range("C6" & Range("C65536").End(3).Row).Copy
Range("H6").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
Range("C6").Select
Application.EnableEvents = True
Exit Sub
Son:
Application.CutCopyMode = False
Application.EnableEvents = True
MsgBox Err.Description
End Sub



Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, Range("H6:IV7")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Range("C665536").ClearContents
Range("H6:IV7").Copy
Range("C6").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
Range("H6").Select
Application.EnableEvents = True
Exit Sub
Son:
Application.CutCopyMode = False
Application.EnableEvents = True
MsgBox Err.Description
End Sub

peki sayın arkadaşım bu iki makroyu aynı sayfada nasıl birleştirebilirim?
inanın sormadan önce çok uğraşıyorum.
Yani aynı sayfada iki makronun da etkin olmasını istiyorum.
(hücre isimlerinin değişmesi gerektiğini biliyorum. Sadece aynı sayfada nasıl kombine yapılabilir?)

 

[matit35]

gerçekten bu sorunun cevabına ihtiyacım var.
ikisini aynı sayfaya hangi komut yardımıyla koyabiliriz?
teşekkürler...

 

[Korhan Ayhan]

Selamlar,

Keşke en son istediğiz işlemi en başta açıklasaydınız. Konu gereksiz yere uzayıp gidiyor.

Aşağıdaki şekilde denermisiniz.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, Range("C6:D65536", "H6:IV7")) Is Nothing Then Exit Sub
    If (Target.Column = 3 Or Target.Column = 4) And Target.Row >= 6 Then
        Application.EnableEvents = False
        Range("C6:D65536").ClearContents
        Range("H6:IV7").Copy
        Range("C6").PasteSpecial Paste:=xlPasteValues, Transpose:=True
        Application.CutCopyMode = False
        Range("H6").Select
        Application.EnableEvents = True
        Exit Sub
    End If
    
    If Target.Column >= 8 And Target.Row >= 6 Then
        Application.EnableEvents = False
        Range("H6:IV7").ClearContents
        Range("C6:D" & Range("C65536").End(3).Row).Copy
        Range("H6").PasteSpecial Paste:=xlPasteValues, Transpose:=True
        Application.CutCopyMode = False
        Range("C6").Select
        Application.EnableEvents = True
        Exit Sub
    End If
Son:
    Application.CutCopyMode = False
    Application.EnableEvents = True
    MsgBox Err.Description
End Sub