• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Formüllü hücreyi kopyalayıp özel yapıştırma

Katılım
24 Şubat 2017
Mesajlar
88
Excel Vers. ve Dili
2010-Türkçe
Merhabalar, öncelikle cümleten iyi bayramlar dilerim. aşağıdaki kodlarda tik i seçili olan sekmedeki veriler taranıp I H J hücrelerindeki veriler kopyalanıyor. fakat bu hücrelerde formül olduğundan kopyalama yapamıyor. aşağıdaki kodları sadece hücredeki veriyi metin olarak kopyalaması için düzenleme yapılabilir mi? ( arama yaparkende kopyalarkende metin olarak arama yapılabilir mi)



Kod:
private Sub CommandButton1_Click()

    Dim syf As String, S2 As Worksheet, i As Long, c As Range
    
    Set S2 = Sheets("Sayfa1")
    
    syf = ""
    If ActiveSheet.Shapes("Check Box 26").ControlFormat.Value = 1 Then
        syf = "ahmet"
    End If
    If ActiveSheet.Shapes("Check Box 27").ControlFormat.Value = 1 Then
        syf = "mehmett"
    End If
    If ActiveSheet.Shapes("Check Box 28").ControlFormat.Value = 1 Then
        syf = "nezat"
    End If
    If ActiveSheet.Shapes("Check Box 29").ControlFormat.Value = 1 Then
        syf = "selim"
    End If
    If ActiveSheet.Shapes("Check Box 30").ControlFormat.Value = 1 Then
        syf = "hamza"
    End If
    If ActiveSheet.Shapes("Check Box 31").ControlFormat.Value = 1 Then
        syf = "nizamettin"
    End If
    If syf = "" Then
        Range("G:I").Clear
        MsgBox "sayfa seçilmemiş"
        Exit Sub
    End If
    
    Range("G:I").Clear
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        Set c = Sheets(syf).[B:B].Cells.Find(Cells(i, "B"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            [COLOR="Red"]Sheets(syf).Cells(c.Row, "H").Resize(1, 3).Copy Cells(i, "G")[/COLOR]
        End If
    Next i
        son = Cells(Rows.Count, "I").End(3).Row
    Range("I2:I" & son).SpecialCells(xlCellTypeBlanks) = "TRM-Bos"
End Sub
 
Son düzenleme:
Kırmızı bölümü aşağıdaki gibi değiştirip deneyiniz.

Kod:
    Sheets(syf).Cells(c.Row, "H").Resize(1, 3).Copy
    Cells(i, "G").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
 
çok teşekkür ederim hocam
 
Geri
Üst