• DİKKAT

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

Aynı Hücreye Yazılan Veriyi Başka Hücrelere Yazma

Katılım
21 Ocak 2017
Mesajlar
6
Excel Vers. ve Dili
VBA
Merhabalar,
Sorunumla ilgili oldukça araştırma yaptım fakat işime tam anlamıyla yarayanı bulamadım, bu sebeple yardımlarınızı bekliyorum.

SORU:
Excel, 2 çalışma sayfasından oluşmaktadır.
Sayfa1'de H2'den H136'ya kadar veri girişi yapılabilmektedir.
Yapmak istediğim, sayfa1'de girişi yapılan verileri sayfa2'de yazmak.

yani;

sayfa1 H2 hücresini ele alalım. Bu hücreye 3 tane farklı veri gireceği, girdiğim bu veriler sayfa2'de sırasıyla B2, C2 ve D2 ye yazılacak. Sayfa1 H3 verisi Sayfa2 B3, C3 D3, gibi 135 tane hücre için.

NOT: örnekte 3 farklı dedim ama, veri giriş miktarı belli değil.


Şimdiden, cevap veren tüm arkadaşlara teşekkür ediyorum.
 
Son düzenleme:
Örnek dosyanızı https://upterabit.com sitesinden yükleyip linki verebilir misiniz.
Site açıldığında kayıt OLMAYIN UPLOAD butonu ile dosyanızı yükleyin.
 
Örnek dosyanızda örnek görmedim :)

H2 ye üç tane veri gireceğim demişsiniz. Ama H kolonunda veri yok.
Bu veriler nasıl girilecek.
virgülle mi boşluklamı nasıl ayırt ediliyor.

Örnek veri yazar mısınız?

Kusura bakmayın çok açıklayıcı olamadım sanırım :)

Şöyle ki;
mesela bugünü ele alalım. 21.01.2017 tarihinde CN5 eğitimi yapılmış olsun. Dolayısıyla Sayfa1'de H11 hücresine 21.01.2017 değerini gireceğim.Bu değer otomatik olarak Sayfa2 B11'de de yazacak

Ertesi gün (22.01.2017) tarihinde yine aynı eğitim olan CN5 yapalım. Yine H11 hücresine 22.01.2017 değerini gireceğim. Bu sefer Sayfa2'de 22.01.2017 değeri C11'de otomatik olarak yazılması lazım.

Sayfa2 'yi açtığımda B11'de 21.01.2017, C11'de 22.01.2017 yi görmem lazım.
Bu sayede eğitimlerin ne zaman yapıldığına dair elimde otomatik oluşturulmuş bir tablo olacak.

Kusura bakmayın uğraştırıyorum :roll:
 
Kusura bakmayın çok açıklayıcı olamadım sanırım :)

Şöyle ki;
mesela bugünü ele alalım. 21.01.2017 tarihinde CN5 eğitimi yapılmış olsun. Dolayısıyla Sayfa1'de H11 hücresine 21.01.2017 değerini gireceğim.Bu değer otomatik olarak Sayfa2 B11'de de yazacak

Ertesi gün (22.01.2017) tarihinde yine aynı eğitim olan CN5 yapalım. Yine H11 hücresine 22.01.2017 değerini gireceğim. Bu sefer Sayfa2'de 22.01.2017 değeri C11'de otomatik olarak yazılması lazım.

Sayfa2 'yi açtığımda B11'de 21.01.2017, C11'de 22.01.2017 yi görmem lazım.
Bu sayede eğitimlerin ne zaman yapıldığına dair elimde otomatik oluşturulmuş bir tablo olacak.

Kusura bakmayın uğraştırıyorum :roll:

Aynı günde aynı kod ile iki eğitim olmaz değil mi?
Yani en son eklenen tarih tekrar eklenmez.
 
Mükerrer kontrolü için sayfanın kod bölümüne
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [a:IV]) Is Nothing Then Exit Sub
say = WorksheetFunction.CountIf(Range("B11:IV11" & Target.Row - 1), Target)
If say > 1 Then
MsgBox "BU KAYIT MEVCUTTUR"
Target.Select
Target = ""
End If
X = Target.Row
y = Target.Column
ActiveSheet.Rows(X).AutoFit
ActiveSheet.Columns(y).AutoFit
End Sub

H11 hücresine yazdıralan tarihlerin Sayfa2 nin B11 satırına devam etmesi için modüle
Kod:
Sub Makro1()
Sheets("Sayfa1").Select
Sheets("Sayfa1").Range("h11").Copy
Sheets("Sayfa2").Select
Sheets("Sayfa2").Range("a11").Select
ActiveCell.End(xlToRight).Offset(0, 1).Select
ActiveSheet.Paste
Sheets("Sayfa1").Select
Application.CutCopyMode = False
Range("h11").Select
End Sub
yapıştırınız.

Dosyanız ekte

NOT: Eğer H11 hücresinde işlem yapıldığı anda makronun çalışmasını isterseniz Sayfanın kod bölümüne
Kod:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, Range("H11")) Is Nothing Then
Makro1
End If
End Sub
kodunu ekleyiniz
 

Ekli dosyalar

Cevabınız için teşekkür ederim.
Fakat yazdığınız makro sadece H11 hücresini A11'e kopyalıyor ve kopyalamaları hep A11'e yapıyor. Halbuki bir sonraki tarihi B11, ondan sonrakini C11 şeklinde yapsa daha güzel olur. Ayrıca kod sadece H11 hücresi için çalışıyor. H2:H136 şeklinde yapmamız mümkün mü?

Teşekkürler
 
Sayfa1 isimli sayfanızın kod bölümüne uygulayıp deneyiniz.

H2:H136 Hücre aralığına veri girdiğinizde Sayfa2 de aynı satıra sıra ile veri aktarılır.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("H2:H136")) Is Nothing Then Exit Sub
    Set S2 = Sheets("Sayfa2")
    Sutun = S2.Cells(Target.Row, S2.Columns.Count).End(1).Column
    If Target.Value <> "" Then S2.Cells(Target.Row, Sutun + 1) = Target.Value
    MsgBox "Veri aktarılmıştır."
End Sub
 
Alternatif;

Sayfa1 in kod bölümüne ekleyiniz.

* Aynı kod için aynı tarih birden fazla girilirse sayfa2 ye eklemez.
* Girilen tarih aynı kod için son girilen tarihten küçük yada eşit ise ekleme yapmaz.
* Her iki tarafta kodların aynı sırada olmasının önemi yoktur.
* Eğitim kodu sayfa2 de yok ise uyarı verir.

http://www.dosyaupload.com/1Z0h

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub
    Dim kodsatir As Long
     
    On Error Resume Next
    satir = Target.Row
    sutun = Target.Columns
    s1kodu = Cells(satir, 2).Value
    tarih = Target.Value

    Set s2 = Sheets("Sayfa2")
    sonsatira = s2.Cells(Rows.Count, "A").End(3).Row
    kodsatir = s2.Cells.Find(What:=s1kodu, After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    sonsutun = s2.Cells(kodsatir, s2.Columns.Count).End(xlToLeft).Column
    s2tarih = s2.Cells(kodsatir, sonsutun).Value
    
    If kodsatir = 0 Then
      MsgBox ("Eğitim kodu sayfa2 de bulunamadı")
      Exit Sub
    End If
    
    If sonsutun = 1 Then
        s2.Cells(kodsatir, sonsutun + 1).Value = tarih
    Else
       If CDate(tarih) > CDate(s2tarih) Then
          s2.Cells(kodsatir, sonsutun + 1).Value = tarih
       End If
    End If
End Sub
 
Son düzenleme:
Sayfa1 isimli sayfanızın kod bölümüne uygulayıp deneyiniz.

H2:H136 Hücre aralığına veri girdiğinizde Sayfa2 de aynı satıra sıra ile veri aktarılır.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("H2:H136")) Is Nothing Then Exit Sub
    Set S2 = Sheets("Sayfa2")
    Sutun = S2.Cells(Target.Row, S2.Columns.Count).End(1).Column
    If Target.Value <> "" Then S2.Cells(Target.Row, Sutun + 1) = Target.Value
    MsgBox "Veri aktarılmıştır."
End Sub

Teşekkür ederim tam isteğim gibi çalısiyor.

Asri bey sizin yontemi de deneyip sonucu yazacagim.

İlgi ve alakanız için çok çok teşekkür ederim.
 
Kusura bakmayın çok açıklayıcı olamadım sanırım :)

Şöyle ki;
mesela bugünü ele alalım. 21.01.2017 tarihinde CN5 eğitimi yapılmış olsun. Dolayısıyla Sayfa1'de H11 hücresine 21.01.2017 değerini gireceğim.Bu değer otomatik olarak Sayfa2 B11'de de yazacak

Ertesi gün (22.01.2017) tarihinde yine aynı eğitim olan CN5 yapalım. Yine H11 hücresine 22.01.2017 değerini gireceğim. Bu sefer Sayfa2'de 22.01.2017 değeri C11'de otomatik olarak yazılması lazım.

Sayfa2 'yi açtığımda B11'de 21.01.2017, C11'de 22.01.2017 yi görmem lazım.
Bu sayede eğitimlerin ne zaman yapıldığına dair elimde otomatik oluşturulmuş bir tablo olacak.

Kusura bakmayın uğraştırıyorum :roll:

Ben yanlış anlamışım diyecek tekrar okuduğumda yine aynısını anladım, yine h11 hücresine gereceğim...

not: sayfa2 de a11 ve b11 dolu olması gerekiyor, sonrası dediğiniz gibi kayıt yapıyor
 
Geri
Üst