Makro ile arama ve offset

[aydogankemal]

Merhabalar,
Excel kitabındaki "model" sayfasında CTK.2232 verisini bulmak istiyorum. (CTK.2232 formül ile gelen bir değer).
aranan değeri bulduktan sonra CTK2232 yazan hücrenin 1 hücre solunu seçecek,
sonra sağ tarafa doğru 3 hücre, aşağı doğru 39 hücre seçip seçili alanı kopyalayacak
veri hücresi a1 e yapıştıracak,
Umarım çok karışık olmamıştır, örnek dosya ektedir

 

[veyselemre]

Sub findValue()
    Dim c As Range
    Dim ara As String
    Range("A:C").Clear
    ara = "CTK.2232"
    Set c = Cells.Find(ara, , xlValues)
    If Not c Is Nothing Then
        c.Offset(, -1).Resize(39, 3).Copy
        With Range("A1")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
        End With
    End If
    Application.CutCopyMode = False
End Sub

 

[ÖmerFaruk]

Boş bir modül içine kopyalayıp kullanabilirsiniz.

Sub Bul_Kopyala_Yapıştır()
    Dim Aranan As Variant, Bul As Range, Sh As Worksheet
    Set Sh = Worksheets("model")
    Aranan = "CTK.2232"
    Set Bul = Sh.Cells.Find(Aranan, , xlValues)
    If Bul Is Nothing Then
        MsgBox "Aranan " & Aranan & " değer bulunamadı"
        Exit Sub
    Else
        Bul.Offset(, -1).Resize(39, 3).Copy
        Worksheets("veri").Range("A1").PasteSpecial xlPasteValues
        'Formatları da kopyalamak isterseniz aşağıdaki satırın başındaki tek tırnağı kaldırın.
        Worksheets("veri").Range("A1").PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
    End If
End Sub

 

[aydogankemal]

Sub findValue()
    Dim c As Range
    Dim ara As String
    Range("A:C").Clear
    ara = "CTK.2232"
    Set c = Cells.Find(ara, , xlValues)
    If Not c Is Nothing Then
        c.Offset(, -1).Resize(39, 3).Copy
        With Range("A1")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
        End With
    End If
    Application.CutCopyMode = False
End Sub

Teşekkür ederim.