Sayfadan veri almak

[ressevet]

B1 ve b2 hücre girişlerinde daire adlı sayfadaki semada ilgili bloktaki daire hücresi ne müşteri adının otomatik yazdırılması ve hücrenin renk değiştirmesi gerekmektedir.


Bu konuda yardımlarınızı rica ederim

 

[dEdE]

Merhaba,
Otomatik yazdırmak için müşterinin adını nereden alacağız?

 

[ressevet]

sayfa adından alınacak hocam

 

[ressevet]

sayfa adından alamazsak daire no altındaki sutuna müşteri adı diye bir sutun oluşturabilriz

 

[dEdE]

Merhaba,
Dosyanız ilişiktedir.

ThisWorkbook kod bölümüne yazılacak kod:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If ActiveSheet.Name = "DAİRE" Then Exit Sub
    If Intersect(Target, [B1:B2]) Is Nothing Then Exit Sub
    If ActiveSheet.Range("B1").Value = "" Or ActiveSheet.Range("B2").Value = "" Then Exit Sub
    s2 = ActiveSheet.Name
    Aktar
End Sub

Modüle yazılacak kod:

Public s2 As String
Sub Aktar()
Application.ScreenUpdating = False
Set s1 = Sheets("DAİRE")
Set aranan = s1.Cells.Find(Sheets(s2).Range("B1").Value, , xlValues, xlPart)
If Not aranan Is Nothing Then
    Kolon1 = aranan.Column
    Kolon2 = aranan.Column + 6
    Satır1 = aranan.Row + 1
    Satır2 = aranan.Row + 19
    
    s1.Select
    s1.Range(Cells(Satır1, Kolon1), Cells(Satır2, Kolon2)).Select
    Set Aranan1 = Selection.Find(Sheets(s2).Range("B2").Value, , xlValues, xlWhole)
    If Not Aranan1 Is Nothing Then
        Range(Aranan1.Address).Interior.ColorIndex = 6
        Range(Aranan1.Address).Value = Sheets(s2).Range("B2").Value & " " & Sheets(s2).Name
    End If
    MsgBox Sheets(s2).Range("B1").Value & " Blok " & Sheets(s2).Range("B2").Value & " numaraya " _
    & Sheets(s2).Name & " kayıt edildi.", vbInformation
End If
    Sheets(s2).Select
Application.ScreenUpdating = True
End Sub