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

Filose

Altın Üye
Katılım
22 Ekim 2012
Mesajlar
262
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

dalgalikur

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
3,095
Excel Vers. ve Dili
2013
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:

Filose

Altın Üye
Katılım
22 Ekim 2012
Mesajlar
262
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
 

Filose

Altın Üye
Katılım
22 Ekim 2012
Mesajlar
262
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...
 

Filose

Altın Üye
Katılım
22 Ekim 2012
Mesajlar
262
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,
 

dalgalikur

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
3,095
Excel Vers. ve Dili
2013
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
 

Filose

Altın Üye
Katılım
22 Ekim 2012
Mesajlar
262
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.
 

Filose

Altın Üye
Katılım
22 Ekim 2012
Mesajlar
262
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.
 

dalgalikur

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
3,095
Excel Vers. ve Dili
2013
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.
 

Filose

Altın Üye
Katılım
22 Ekim 2012
Mesajlar
262
Excel Vers. ve Dili
Office 2016 Türkçe
Çok teşekkür ediyorum.
Sağlık ve huzur diliyorum.
 
Üst