Soru Sayfadan diğer sayfaya birkaç hücrenin verisi aktarmak ve diğer sayfadan istenilen bilgiyi varolan sayfada popup veya mesaj olarak getirmek.

Katılım
22 Ekim 2012
Mesajlar
311
Excel Vers. ve Dili
Office 2016 Türkçe
Herkese merhaba,
Ekte bulunan çalışma sayfasına küçük bir şey ilave etmek istiyorum.

1. Dönem butonuna basıldığında o satırdaki veriler TÜM-GV sayfasında hangi firma ise onun altına aynı yere yazsın. Birde buradaki BQ7 deki hücre verisini ikinci sayfadaki ORT hücresine yazsın

Aynı şekilde 2,3 ve 4.dönem aynı
Burada aynı sayfadan aynı sayfaya aktarabiliyorum 1,2,3,4. dönem tuşların makroları var ama bu pek kullanışlı olmadı.

Ayrı sayfada daha verimli olacak.

Herkese saygı ve sağlık diliyorum.
 

Ekli dosyalar

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,803
Excel Vers. ve Dili
2019 Türkçe
Merhaba.

Butonların kodlarını silin onların yerine aşağıdakileri kopyalayın.

Kod:
Sub Aktar01()
    Aktar "1. DÖNEM"
End Sub
Sub Aktar02()
    Aktar "2. DÖNEM"
End Sub
Sub Aktar03()
    Aktar "3. DÖNEM"
End Sub
Sub Aktar04()
    Aktar "4. DÖNEM"
End Sub

Sub Aktar(Donem As String)
    Dim FirmaAdi As String
    Dim syfTumGv As Worksheet
    Dim syfGv As Worksheet
    Dim FirmaBul As Range
    Dim FirmaSatir As Long
    Dim Satir As Long
    Set syfTumGv = ThisWorkbook.Worksheets("TÜM-GV")
    Set syfGv = ThisWorkbook.Worksheets("GV")
    FirmaAdi = syfGv.Range("BK44")
    Set FirmaBul = syfTumGv.Range("C:I").Find(FirmaAdi)
    If FirmaBul Is Nothing Then
        MsgBox "Firma bulunamadı.", vbExclamation
        Exit Sub
    End If
    Select Case Donem
        Case "1. DÖNEM"
            FirmaSatir = 2 + FirmaBul.Row
            Satir = 40
           
        Case "2. DÖNEM"
            FirmaSatir = 3 + FirmaBul.Row
            Satir = 41
        Case "3. DÖNEM"
            FirmaSatir = 4 + FirmaBul.Row
            Satir = 42
        Case "4. DÖNEM"
            FirmaSatir = 5 + FirmaBul.Row
            Satir = 43
    End Select
    syfTumGv.Range("D" & FirmaSatir) = syfGv.Range("BP" & Satir)
    syfTumGv.Range("E" & FirmaSatir) = syfGv.Range("BW" & Satir)
    syfTumGv.Range("F" & FirmaSatir) = syfGv.Range("CD" & Satir)
    syfTumGv.Range("G" & FirmaSatir) = syfGv.Range("CI" & Satir)
    syfTumGv.Range("H" & FirmaSatir) = syfGv.Range("CP" & Satir)
    syfTumGv.Range("I" & FirmaSatir) = syfGv.Range("BQ7")
End Sub
GV adlı sayfanın kod kısmına aşağıdaki kodları kopyalayın.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim FirmaAdi As String
    Dim syfTumGv As Worksheet
    Dim FirmaBul As Range
    Dim FotoAlan As Range
    Set syfTumGv = ThisWorkbook.Worksheets("TÜM-GV")
    FirmaAdi = Range("BK44")
    Set FirmaBul = syfTumGv.Range("C:I").Find(FirmaAdi)
    If FirmaBul Is Nothing Then
        MsgBox "Firma bulunamadı.", vbExclamation
        Exit Sub
    End If
    Set FotoAlan = syfTumGv.Range("C" & FirmaBul.Row & ":I" & FirmaBul.Row + 5)
    FotoAlan.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    On Error Resume Next
    Shapes("TumGVFirma").Delete
    Range("BK45").Select
    Paste
    Selection.Name = "TumGVFirma"
End Sub
 
Son düzenleme:
Katılım
22 Ekim 2012
Mesajlar
311
Excel Vers. ve Dili
Office 2016 Türkçe
Merhaba Dalgalıkur,
Deniyorum bilgilendiririm. Ellerinize sağlık çok teşekkür ediyorum.
Sağlıkla kalın
 
Katılım
22 Ekim 2012
Mesajlar
311
Excel Vers. ve Dili
Office 2016 Türkçe
Tekrar merhaba Dalgalıkur,

Her şey çok güzel olmuş. Tam istediğim gibi.
Popup da çok iyi oldu. Sadece firmanın sadece ilk 6 karakterine baksa yeterli olur. Tamamına bakmasına gerek yok.

Tekrar ellerinize sağlık çok teşekkür ediyorum.

Sağlık ve huzurla kalın...
 
Katılım
22 Ekim 2012
Mesajlar
311
Excel Vers. ve Dili
Office 2016 Türkçe
Merhaba Dalgalıkur,

Sadece BK44 Hücresine firma ismi yazdığım zaman Popup gelmesini sağlayabilirmiyiz.
Çünkü, GV sayfasına girdiğim herhangi bir hücreye değer girdiğimde veya değiştirdiğim de popup her zaman geliyor.
Sadece BK44 hücresine firma ismi yazdığımda olsa çok daha iyi olacak.

Saygı ve hürmetle,
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,803
Excel Vers. ve Dili
2019 Türkçe
Merhaba.
Gözden kaçırmışım.
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim FirmaAdi As String
    Dim syfTumGv As Worksheet
    Dim FirmaBul As Range
    Dim FotoAlan As Range
    If Not Intersect(Target, Range("BK44")) Is Nothing Then
        Set syfTumGv = ThisWorkbook.Worksheets("TÜM-GV")
        FirmaAdi = Range("BK44")
        Set FirmaBul = syfTumGv.Range("C:I").Find(FirmaAdi)
        If FirmaBul Is Nothing Then
            MsgBox "Firma bulunamadı.", vbExclamation
            Exit Sub
        End If
        Set FotoAlan = syfTumGv.Range("C" & FirmaBul.Row & ":I" & FirmaBul.Row + 5)
        FotoAlan.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        On Error Resume Next
        Shapes("TumGVFirma").Delete
        Range("BK45").Select
        Paste
        Selection.Name = "TumGVFirma"
    End If
End Sub
 
Katılım
22 Ekim 2012
Mesajlar
311
Excel Vers. ve Dili
Office 2016 Türkçe
Çok teşekkür ediyorum. Elinize yüreğinize sağlık.
Sağlıkla kalın.
 
Katılım
22 Ekim 2012
Mesajlar
311
Excel Vers. ve Dili
Office 2016 Türkçe
Tekrar merhaba Dalgalıkur,

GV sayfası için yazdığınız bu son kodu aynı excel dosyasının başka bir sayfasında kullanabilirmiyim.
Bu kod çok işime yaradı ellerinize sağlık.

İyi bayramlar diliyorum.
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,803
Excel Vers. ve Dili
2019 Türkçe
Merhaba.
Evet kullanabilirsiniz.
Dosyanızın yedeğini alıp yedek üzerinde denemeler yapın. Hem bu vesile ile belki başka şeyler de öğrenmiş olursunuz.
Yapamadığınız şey olursa yardımcı olmaya çalışırız.
Kolay gelsin.
 
Katılım
22 Ekim 2012
Mesajlar
311
Excel Vers. ve Dili
Office 2016 Türkçe
Çok teşekkür ediyorum.
Sağlık ve huzur diliyorum.
 
Üst