Soru Başka sayfadan veri alma

[tansileta]

Merhaba

Öncelikle aklımdaki şeyi umarım anlatabilirim.
iş için oluşturduğum bir excel sayfam var fakat el ile yazmak beni çok yoruyor yardımlarınızı bekliyorum.



Bu sayfada F VE G sütunlarını örnek olarak SP03 VE SPP03 veriyi el ile girdiğimde



yukarıdaki örnekteki yere otomatik olarak çekmesine yaracak bir formülle ihtiyacım var ben her iki sayfayı da el ile doldurmak zorunda kalıyorum yardımcı olursanız sevinirim.

 

[Ömer]

Merhaba,

Yukarıdaki örnek dediğiniz yer neresi. Sorunuz açıklayıcı değil. Hücre adresi vererek daha detaylı açıklama yapınız.

 

[tansileta]

Merhaba,

Yukarıdaki örnek dediğiniz yer neresi. Sorunuz açıklayıcı değil. Hücre adresi vererek daha detaylı açıklama yapınız.

Merhaba ,

İlk görseldeki F VE G sütunlarını örnek olarak SP03 VE SPP03 verisini 2. resimdeki A3 Yazıyorum.

i

 

[Greenblacksea53]

SD PLANI A3 hücresine =BİRLEŞTİR('34FENER_CORE_PLAN'!F2;" ";'34FENER_CORE_PLAN'!G2) yazıp verileri alırsın ama tablo çok dağınık.

 

[Ömer]

Merhaba,

Detaylı deneme yapmadım. Hata varsa hücre adresi vererek nedenini açıklayınız.

Sub test()
    
    Dim S1 As Worksheet, S2 As Worksheet
    Dim i As Long, r As String, j As Byte, c As Range, renk As String, kod As String
    
    Set S1 = Sheets("34FENER_CORE_PLAN")
    Set S2 = Sheets("SD PLANI")
    
    Application.ScreenUpdating = False
    
    For i = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row Step 12
        For j = 1 To 12
            renk = Left(S1.Cells(i, "I"), 3)
            If renk = "MEN" Then renk = "MOR"
            kod = Split(S1.Cells(i, "H"), "_")(2) & Val(Split(S1.Cells(i, "H"), "_")(3))
            r = kod & "-" & renk & "*P" & j
            Set c = S2.Cells.Find(r, , xlValues, xlWhole)
            If Not c Is Nothing Then
                With S2.Cells(c.Row + 1, c.Column)
                    .Value = ""
                    .Interior.ColorIndex = xlNone
                    If S1.Cells(i + j - 1, "F") <> "" Then
                        .Value = S1.Cells(i + j - 1, "F") & "/" & S1.Cells(i + j - 1, "G")
                        .Interior.ColorIndex = 43
                    End If
                End With
            End If
        Next j
    Next i
    
    Application.ScreenUpdating = True
    
End Sub

 

[tansileta]

Merhaba,

Detaylı deneme yapmadım. Hata varsa hücre adresi vererek nedenini açıklayınız.

Sub test()
   
    Dim S1 As Worksheet, S2 As Worksheet
    Dim i As Long, r As String, j As Byte, c As Range, renk As String, kod As String
   
    Set S1 = Sheets("34FENER_CORE_PLAN")
    Set S2 = Sheets("SD PLANI")
   
    Application.ScreenUpdating = False
   
    For i = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row Step 12
        For j = 1 To 12
            renk = Left(S1.Cells(i, "I"), 3)
            If renk = "MEN" Then renk = "MOR"
            kod = Split(S1.Cells(i, "H"), "_")(2) & Val(Split(S1.Cells(i, "H"), "_")(3))
            r = kod & "-" & renk & "*P" & j
            Set c = S2.Cells.Find(r, , xlValues, xlWhole)
            If Not c Is Nothing Then
                With S2.Cells(c.Row + 1, c.Column)
                    .Value = ""
                    .Interior.ColorIndex = xlNone
                    If S1.Cells(i + j - 1, "F") <> "" Then
                        .Value = S1.Cells(i + j - 1, "F") & "/" & S1.Cells(i + j - 1, "G")
                        .Interior.ColorIndex = 43
                    End If
                End With
            End If
        Next j
    Next i
   
    Application.ScreenUpdating = True
   
End Sub

desteğiniz için çok teşekkür ederim sorunsuz çalışmaktadır

 

[tansileta]

Formül sorunsuz çalışıyor fakat turkuaz kısmını boş bırakıyor sadece

 

[Ömer]

Eklediğiniz dosyada 34FENER_CORE_PLAN sayfasındaki Turkuaz karşılığındaki F ve G sütunlarında veri yok. Kontrol ediniz.