• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Soru Sütün Numarasına Göre Veri Getirme

7. satırın hücre biçimini GENEL yapınız; aşağıdaki kodu sayfa kaynağına ekleyiniz.

Edit:
Hücreler temizlenirse sütunda temizlenir.

C++:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C7:G7")) Is Nothing Then
        Dim searchRange As Range
        Set searchRange = Range("M7:Y7")
        Set foundCell = searchRange.Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not foundCell Is Nothing Then
            Dim lastRow As Long
            lastRow = Cells(Rows.Count, foundCell.Column).End(xlUp).Row
            Range(foundCell.Offset(1, 0), Cells(lastRow, foundCell.Column)).Copy Destination:=Target.Offset(1, 0)
        Else
            Dim clearRange As Range
            Set clearRange = Target.Offset(1, 0).Resize(Rows.Count - Target.Row, 1)
            clearRange.Clear
        End If
    End If
End Sub
 

Ekli dosyalar

Son düzenleme:
Bozkurt öncelikle teşekkür ederim..
ancak hata veriyor nereden kaynaklı

@NADİR YILDIZ Kod içeriğine silme işlevi ekleyip 2. mesaja dosya olarak da ekledim,

Bu kodu MÜŞTERİ sayfasına sağ tıklayıp; Kod Görüntüle kısmına yapıştırmanız gerekir.
CommandButon ile çalışmaz.
 
Üstat teşekkürler evet aynen dediğiniz gibi

bir şey daha rica etsem forumda bir soru daha sormuştum.bu konuda da yardımcı olabilirmisiniz rica etsem

 
Sabah baktım biraz maalesef kurguyu kuramadım o konunuzda.
 
Merhaba,
Alternatif olsun, dizilerle çözüm
Not : 1. tablo ile 2. tablo arasında boş sütun olmalı.

Kod:
Sub Makro1()
    
Dim rngOku As Variant, _
    rng    As Variant, _
    rngYaz As Variant, _
    i      As Long, _
    j      As Integer, _
    k      As Integer
 
rngOku = Range(Range("C7"), Range("C7").End(xlToRight)).Value
rng = Range("M8").CurrentRegion.Offset(1).Value
    
ReDim rngYaz(1 To UBound(rng, 1), 1 To UBound(rngOku, 2))

For i = 1 To UBound(rng, 1)
    k = 0
    For j = 1 To UBound(rngOku, 2)
        k = k + 1
        rngYaz(i, k) = rng(i, rngOku(1, j))
    Next j
Next i

Range("C7").CurrentRegion.Offset(1).ClearContents
Range("C8").Resize(UBound(rng, 1), UBound(rngYaz, 2)) = rngYaz

End Sub
 
Son düzenleme:
Necdet bey teşekkürler
kodları butona kopyalayıp çalıştırdığımda girdiğim sütun numaralarını siliyor
nerden kaynaklı olabilir

iyi çalışmalar
 
current.region olayından dolayı siliyor.
Kodu düzenledim, yeniden deneyiniz.
 
Gönderdiğiniz dosyaya göre kodu yazmıştım.
silme olayını kendinize göre düzenleyebilirsiniz
 
Geri
Üst