Hücredeki değere göre ilgili sayfaya gitme

[kahramang1]

Merhabalar. Ben ekli dosyada gelişmiş sekmesindeki "makro kaydet" özelliği ile veri sayfasında (B2:B17) arasını kopyalatıp, "ocak" sayfasının ilk boş satırına sadece değerleri yatay hale getirip yazdırmasını sağladım. Sizden ricam yan tarafa "şubat" sayfasını açtığımda(mart, nisan, mayıs, haziran, temmuz, ağustos, eylül, ekim, kasım, aralık sayfaları da açılacaktır) ve B1 hücresinde hangi ayın ismini yazdıysam o sayfaya gidip verileri oraya yazmasıdır. Örneğin B1 de şubat yazıyorsa veriyi o sayfaya yazdırmasını sağlamanızdır. Teşekkürler.

 

[YUSUF44]

Aşağıdaki makroyu deneyiniz:

Sub aktar()
    Set s1 = Sheets("veri")
    If s1.[B1] <> "" Then
        sayfa = "yok"
        For i = 1 To Sheets.Count
            s1.Cells(i, "H") = WorksheetFunction.Proper(s1.[B1])
            s1.Cells(i, "I") = WorksheetFunction.Proper(Sheets(i).Name)
            If WorksheetFunction.Proper(Sheets(i).Name) = WorksheetFunction.Proper(s1.[B1]) Then
                yeni = Sheets(i).Cells(Rows.Count, "A").End(3).Row + 1
                s1.Range("B2:B18").Copy: Sheets(i).Cells(yeni, "A").PasteSpecial Paste:=xlPasteValues, _
                    Operation:=xlNone, SkipBlanks:=False, Transpose:=True
                Application.CutCopyMode = False
                s1.Range("B2:B18").ClearContents
                s1.Activate
                s1.Range("B2").Select
                sayfa = "var"
                i = Sheets.Count
                Exit Sub
            End If
        Next
    End If
    If sayfa = "yok" Then
        MsgBox s1.[B1] & " ayına ait sayfa bulunamadığından işlem yapılmadı", vbCritical
    End If
End Sub

 

[bmutlu966]

Ben de basitçe ekteki gibi yaptım.

 

[kahramang1]

Yusuf bey çok ama çok teşekkür ederim. Harika olmuş. Tam istediğim gibi. Elinize, gönlünüze sağlık. Kolay gelsin.

 

[kahramang1]

Ben de basitçe ekteki gibi yaptım.

Yeni gördüm mesajınızı. Ellerinize sağlık. Gayet güzel olmuş. İlgi ve alakanız beni çok mutlu etti. Kolay gelsin.