Aranan değerin istenilen sayfada var ise satırı kopyalamak.

[a_self_lion]

Selam arkadaşlar.
Yapmak istediğim D1 hücresinde yazılı olan değeri (V2 den V13 hücresinde var olan sayfa adlarını) çalışma kitabımda böyle bir sayfa var ise bu sayfaların D sütununda arama yaparak bu D1 hücresindeki değeri bulduğumuz vakit AYLAR KONTROL sayfasında hemen A3 den başlayıp dolu ise bir altına kopyalama işlemini nasıl yapabiliriz. Örnek 120203006 nolu kodu ben sayfalarda var ise kendim elimle AYLAR KONTROL sayfasına kopyaladım bunu macro ile nasıl yapabilirim. Örnek dosyam ektetedir. Ayrıca orda ne yapmak istediğimi daha net anlattım.
Kısaca bir kolaylık olsun diye bir acemice kodların işlemesi mantığını yazmak istedim. Anlatmak istediğimi daha iyi anlatmak için.
AYLAR KONTROL sayfası A3:U1000 arasını temizle
D1 hücresi değeri al
V2 hücre değerini al sayfalara bak böyle bir ad var ise o çalışma sayfasını aktif et içinde d sütunda D1 hücresi değerini ara
Bulunca Kopyala:
V3 hücre değerini al sayfalara bak böyle bir ad var ise o çalışma sayfasını aktif et içinde d sütunda D1 hücresi değerini ara
Bulunca Kopyala:
...
...
...
Kopyala:
Bulunca satırı komple seç ve AYLAR KONTROL sayfasına A3 e bak boş ise kopyala
dolu ise bir alt satıra bak kopyala
...

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub SayfalardanAktar()
 
    Dim i As Integer, c As Range, Adr As Variant, son As Long
 
    With Application
        .Calculation = xlManual
        .ScreenUpdating = False
    End With
 
    Sheets("AYLAR KONTROL").Select
    Range("A3:U" & Rows.Count).ClearContents
 
    For i = 1 To Worksheets.Count
        With Sheets(i)
            If WorksheetFunction.CountIf(Range("V:V"), .Name) > 0 Then
                Set c = .Range("D:D").Find(Range("D1"), , xlValues, xlWhole)
                If Not c Is Nothing Then
                    Adr = c.Address
                    Do
                       son = Cells(Rows.Count, "D").End(xlUp).Row + 1
                      .Range("A" & c.Row & ":U" & c.Row).Copy Cells(son, "A")
                    Set c = .Range("D:D").FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> Adr
                End If
            End If
        End With
    Next i
 
    With Application
        .Calculation = xlAutomatic
        .ScreenUpdating = True
    End With
 
End Sub

.

 

[a_self_lion]

Ömer bey gerçekten elinize sağlık. Çok teşekkür ederim.