Excelde aynı hücreye girilen verileri başka hücrelere aktarmak

Katılım
8 Kasım 2018
Mesajlar
36
Excel Vers. ve Dili
2010 tr
Altın Üyelik Bitiş Tarihi
8.11.2019
Merhabalar
Webde şöyle bir makro buldum

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
For i = 1 To Range("C65535").End(xlUp).Offset(1, 0).Row
If Range("C" + CStr(i)).Value = "" Then
Range("C" + CStr(i)).Value = Target.Value
Exit For
End If
Next i
End If
End Sub

Bu makro ile A1 hücresine her girdiğim değeri C sütununda alt alta yazıyor
A1 hücresini manuel olarak ben değiştirdiğimde sıkıntı yok
Ancak A1 hücresindeki veriyi ben webden otomatik olarak alıyorum
Değer otomatik değiştiğinde bu işlemi yapmıyor

Yardıncı olabilirmisiniz
Teşekkürler
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Merhaba.
Aşağıdaki kodları kullanın.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("$A$1")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    Range("C" & Cells(Rows.Count, "C").End(3).Row + 1) = Target.Value
    Application.EnableEvents = True
End Sub
 
Katılım
8 Kasım 2018
Mesajlar
36
Excel Vers. ve Dili
2010 tr
Altın Üyelik Bitiş Tarihi
8.11.2019
Merhaba
İlginize teşekkürler
Ancak aynı oluyor
Değer webden güncellenince otomatik olarak C sütununa yazmıyor
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
O zaman webden veri çeken kodların sonuna aşağıdaki kodları kopyalayın.
Her web güncellemesi sonunda bu kodlar da çalışacaktır ve istediğiniz işlemi gerçekleştirecektir.

Kod:
    Application.EnableEvents = False
    Range("C" & Cells(Rows.Count, "C").End(3).Row + 1) = Target.Value
    Application.EnableEvents = True
 
Katılım
8 Kasım 2018
Mesajlar
36
Excel Vers. ve Dili
2010 tr
Altın Üyelik Bitiş Tarihi
8.11.2019
Merhaba
webden api dosyası ile veri alıyorum
örnek dosyayı ekliyorum
yardımcı olabilirmisiniz
teşekkürler
 

Ekli dosyalar

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
"BTC" ve "ETH" sayfalarının B1 hücresinde bulunan formülleri =DÜŞEYARA(A1;_24hr;2)şununla =DÜŞEYARA(A1;Sayfa2!A:B;2)değiştirin.
 
Katılım
8 Kasım 2018
Mesajlar
36
Excel Vers. ve Dili
2010 tr
Altın Üyelik Bitiş Tarihi
8.11.2019
Merhaba
Yine aynı değer güncellenince güncellenen değeri sütuna yazmıyor
Teşekkürler
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Sayfa2 de güncelleme olduğunda çalışacak şekilde ayarlanabilir.
Ancak orijinal dosyanız da örnek dosyadaki gibi sayfa isimleri A sutununda bulunan verinin ilk üç harfi şeklinde mi?
Yani eğer Sayfa2 B kolonunda bir değişiklik olursa A sütunundaki verinin ilk üç harfine bakacağım o sayfanın C kolonuna ekleme yapacağım. Bu şekilde olsa olur mu?
 
Son düzenleme:

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
O zaman dosyadaki tüm kodları silin aşağıdaki kodu Sayfa2 niin kod kısmına kopyalayın.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    With Worksheets(Left(Target(1, 0).Value, 3))
        .Range("D" & .Cells(Rows.Count, "D").End(3).Row + 1) = Target.Value
    End With
    Application.EnableEvents = True
End Sub
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Olası bir hata ile karşılaşmamak için sayfa kontrolü de yapmak gerek.
Aşağıdaki kodları kullanmanız daha doğru olur.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim SayfaAdi As String
    Dim Syf As Worksheet
    Dim SayfaVar As Boolean
    If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
    
    SayfaAdi = Left(Target(1, 0).Value, 3)
    For Each Syf In ThisWorkbook.Worksheets
        If Syf.Name = SayfaAdi Then
            SayfaVar = True
            Exit For
        End If
    Next
    If Not SayfaVar Then
        MsgBox SayfaAdi & " adlı sayfa bulunamıyor."
        Exit Sub
    End If
    Application.EnableEvents = False
    With ThisWorkbook.Worksheets(SayfaAdi)
        .Range("D" & .Cells(Rows.Count, "D").End(3).Row + 1) = Target.Value
    End With
    Application.EnableEvents = True
End Sub
 
Katılım
8 Kasım 2018
Mesajlar
36
Excel Vers. ve Dili
2010 tr
Altın Üyelik Bitiş Tarihi
8.11.2019
Merhaba
Söylediklerinizi yaptım
Belki benim hatam olmuştur
Ben çalıştıramadım
Size gönderdiğiniz kodu eklediğim dosyayı gönderiyorum
Yardımlarınız için teşekkürler
 

Ekli dosyalar

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Dosya bende güncelleme yapmıyor hata veriyor o yüzden güncelleme yaparken hangi olayın çalıştığını bulamıyorum.
Ekteki dosyayı açın güncelleme yaptığında bir rakamı mesaj olarak gösterecek bana hangi rakamı mesaj gösterdiğini söyleyin bir de bu yöntemi deneyelim.
 

Ekli dosyalar

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Benim gönderdiğim dosyadaki kodları kendi dosyanıza kopyalayıp deneyin.
 
Katılım
8 Kasım 2018
Mesajlar
36
Excel Vers. ve Dili
2010 tr
Altın Üyelik Bitiş Tarihi
8.11.2019
Merhaba Hocam
Bu koddan dolayı veri güncelleme yapamıyor
Ben denedim
Bu kod olmazsa güncelleme çalışıyor

Private Sub Worksheet_Change(ByVal Target As Range)
Dim SayfaAdi As String
Dim Syf As Worksheet
Dim SayfaVar As Boolean
If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub

SayfaAdi = Left(Target(1, 0).Value, 3)
For Each Syf In ThisWorkbook.Worksheets
If Syf.Name = SayfaAdi Then
SayfaVar = True
Exit For
End If
Next
If Not SayfaVar Then
MsgBox SayfaAdi & " adlı sayfa bulunamıyor."
Exit Sub
End If
Application.EnableEvents = False
With ThisWorkbook.Worksheets(SayfaAdi)
.Range("D" & .Cells(Rows.Count, "D").End(3).Row + 1) = Target.Value
End With
Application.EnableEvents = True
End Sub
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Sadece o kodları sil.
Güncelleme yaptığı zaman mesaj ile bir numara göstermesi lazım. O numarayı bana söyle.
 
Katılım
8 Kasım 2018
Mesajlar
36
Excel Vers. ve Dili
2010 tr
Altın Üyelik Bitiş Tarihi
8.11.2019
Sadece o kodları sildiğimde
Güncelleme yapıyor hata vermiyor
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Ben bu konuda yardımcı olamıyorum.
 
Üst