tek tuş ile aktarma

[canmert01]

selam,bu konuyu tekrar tekrar açıyor olacağım ama maksat öğrenmek olunca yanlışlık yok gibi.şunu yapmanın kodu nedir acaba;1.sayfadaki a sütununda malzeme b sütununda fiyat.tekrar c sütununda malzeme d sütununda fiyat ve böylece sıralanacak amaç tabloyu tek seferde görmek sonra bu malzemeler ve yanındaki fiyat tek tuş ile sayfa 3 teki b sütununa fiyat c sütununa fiyat getirmek için ne yapmalıyım + yine 2 sayfada da 1 sayfadaki gibi malzeme ve fiyatlarımız var buradada tek tuş ile 3 sayfada b sütununa malzeme c sütununa fiyat gelicek ve bu sayfalrdan gelen datalar alt alta sıralanacak.
forumda örnek çok fakat ne kadar uğraştıysam mantığı çözemedim..yardımlarınız için şimdiden teşekkür ederim...

 

[fedeal]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 <> Empty Or Target.Column = 3 <> Empty Or Target.Column = 5 <> Empty Or Target.Column = 7 <> Empty Or Target.Column = 9 <> Empty Or Target.Column = 11 <> Empty Or Target.Column = 13 <> Empty Then
For Each fCell In Selection
fed = Sheets("sayfa3").Range("b65536").End(xlUp).Row + 1
Sheets("sayfa3").Range("b" & fed).Value = fCell.Value
Sheets("sayfa3").Range("e" & fed).Value = ActiveCell.Offset(0, 1).Value
Next fCell
End If
End Sub

sayfa1'in kod bölümüne ekleyin ürünün bulundugu hücreyi seçince sayfa3'e aktaracaktır.

 

[Necdet]

Merhaba,

Bir örnekte benden olsun.

Option Explicit
Sub Birlestir()
Dim i As Long, Satır As Long, SonSatır As Long
Dim SonSütun As Integer, SayfaNo As Integer, j As Integer
Dim s1 As Worksheet, s3 As Worksheet
Set s3 = Sheets("Sayfa3")
Application.ScreenUpdating = False
s3.Range("B11:B65536,E11:E65536").ClearContents
For SayfaNo = 1 To 2
    Set s1 = Sheets(SayfaNo)
    s1.Select
    SonSütun = s1.[IV1].End(1).Column - 1
    For j = 1 To SonSütun Step 2
        SonSatır = s1.Cells(65536, j).End(3).Row
        Satır = s3.[B65536].End(3).Row + 1
        s1.Range(Cells(2, j), Cells(SonSatır, j)).Copy s3.Range("B" & Satır)
        s1.Range(Cells(2, j + 1), Cells(SonSatır, j + 1)).Copy s3.Range("B" & Satır).Offset(0, 3)
    Next j
Next SayfaNo
s3.Select
Range("A11:A12").AutoFill Destination:=Range("A11:A" & [B65536].End(3).Row)
Application.CutCopyMode = False
End Sub