• DİKKAT

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

bilgileri başka sayfaya aktarmak

M

mesutaygun70

Katılım
27 Şubat 2008
Mesajlar
307
Excel Vers. ve Dili
Office 2016
iyi günler. ben excelde yaptığım çalışma kitabına yazdır butonu koydum. istediğim yazdır butonuna bastığımda o sayfadaki belirli hücrelerin başka bir sayfaya (ama formüllerin değer olarak) girilmesini sağlamak. yardımlarınızı bekliyorum teşekkürler
 
Alt+F11 tuşlarına basın açılan ekranda Insert -> Module 'yi seçin
Sağ tarafa aşağıdaki kodu yapıştırın.

Sayfa1'de Ekle-> Şekiller'den bir şekil oluşturun.
Şekile sağ tıklayıp "Makro Ata" ve açılan ekrandan "degeraktar"ı seçin tamamdır.
Artık bu şekile tıklayarak Sayfa1'deki tüm verileri DEĞER olarak Sayfa2'ye aktarabilirsiniz.
Kod: 
Sub degeraktar()
    Sheets("Sayfa1").Activate
    Cells.Select
    Selection.Copy
    Sheets("Sayfa2").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("Sayfa1").Activate
    Range("A1").Select
    Application.CutCopyMode = False
End Sub

Makrolar konusunda çok bilgim yok ama, bu şekilde sonuç alabilirsiniz.

Sorunuzda belirli hücreleri demişsiniz. O yüzden tüm hücreleri aktarmanızı sağlar.
Makroyu kendi hazırladığınız DÜĞME'ye de atayabilirsiniz.
 
örnek dosya atarsan yardımcı olabilirim
 
. . .

Yazdır butonu için kodlar.

Kod: 
Private Sub CommandButton1_Click()
    Sayfa4.PrintOut copies:=2

    sor = MsgBox("Kayıt Sayfasına Almak İstiyor Musunuz ?", vbYesNo)
    If sor = vbNo Then Exit Sub
    son_satir = Sayfa10.Range("A:F").Find(What:="*", After:=Sayfa10.Cells(1, "A"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    Sayfa10.Cells(son_satir, "A") = Sayfa4.Range("C6")
    Sayfa10.Cells(son_satir, "B") = Sayfa4.Range("C7")
    Sayfa10.Cells(son_satir, "C") = Sayfa4.Range("I7")
    Sayfa10.Cells(son_satir, "D") = Sayfa4.Range("I13")
    Sayfa10.Cells(son_satir, "E") = Sayfa4.Range("I14")
    Sayfa10.Cells(son_satir, "F") = Sayfa4.Range("I12")

End Sub

. . .
 
Teşekkür ederim Hüseyin bey. çok yararlı oldu ama o an düşünmediğim aynı konu hakkında bir sorun ortaya çıktı. Şöyle ki ekte göndermiş olduğum dosyada; yıllık izin sayfasındaki ı7 hücresinin sayfa1 deki o-ac arasına (odan başlayarak her seferinde bir sonraki sütuna) ama gökan isimine izin yazdığımda gökhanın bulunduğu satıra, mesut ismine izin yazdığımda mesutun bulunduğu satıra olacak şekilde yazmasını isityorum. herkese teşekkürler
http://s3.dosya.tc/server19/PaQNqP/YEN_izinformu.xls.html
 
Yazmayı unuttum tabi bunlar yazdır butonuna bastığımda olacak şekilde hazırlanması lazım.
 
. . .

Dosyanız ektedir.

...::: Ekli Dosyayı İndirmek İçin Linki Tıklayınız :::...
http://yadi.sk/d/C46XenBIKTNaN
Genişletmek için tıkla ...

Kod: 
Private Sub CommandButton1_Click()
    Dim SY     As Worksheet
    Dim SK     As Worksheet
    Dim S1     As Worksheet
    Set SY = Sheets("YILLIK İZİN")
    Set SK = Sheets("kayıt sayfası")
    Set S1 = Sheets("Sayfa1")

    SY.PrintOut copies:=2
    Sayfa2.PrintOut copies:=1
    Sayfa3.PrintOut copies:=1

    sor = MsgBox("Kayıt Sayfasına Almak İstiyor Musunuz ?", vbYesNo)
    If sor = vbNo Then Exit Sub
    son_satir = SK.Range("A:F").Find(What:="*", After:=SK.Cells(1, "A"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    SK.Cells(son_satir, "A") = SY.Range("C6")
    SK.Cells(son_satir, "B") = SY.Range("C7")
    SK.Cells(son_satir, "C") = SY.Range("I7")
    SK.Cells(son_satir, "D") = SY.Range("I13")
    SK.Cells(son_satir, "E") = SY.Range("I14")
    SK.Cells(son_satir, "F") = SY.Range("I12")
    SK.Cells(son_satir, "G") = SY.Range("A2")

    For i = 2 To S1.[A65536].End(3).Row
        If SY.Range("C8") = S1.Cells(i, "A") Then
            sütun = WorksheetFunction.CountA(S1.Range("O" & i & ":AC" & i))
            If sütun = 15 Then
                MsgBox " Sayfa1 de Tüm Sütunlar Dolu, Yazma İşlemi Gerçekleştirilemiyor ! ", vbCritical
                Exit Sub
            Else
                sütun = sütun + 15
                S1.Cells(i, sütun) = SY.Range("I7")
            End If
        End If
    Next i

End Sub

. . .
 

Ekli dosyalar

Kolay gelsin. Çok teşekkür ederim yardımlarınız için. Bi sıkıntım daha var bu konuda. Aynı işlemi yine aynı sayfaya fakat ae ile am sütünları arasına yazdırmasını istiyorum. Yukardaki kodu kendim değiştirdim. Ama bir yerde bir sıkıntı var bulamıyorum. Yardımcı olabilirmisiniz.

Private Sub CommandButton1_Click()
Dim SY As Worksheet
Dim SK As Worksheet
Dim S1 As Worksheet
Set SY = Sheets("hast")
Set SK = Sheets("KAYIT")
Set S1 = Sheets("VERİLER1")
SY.PrintOut copies:=2
Sayfa13.PrintOut copies:=1
Sayfa14.PrintOut copies:=1
sor = MsgBox("Kayıt Sayfasına Almak İstiyor Musunuz ?", vbYesNo)
If sor = vbNo Then Exit Sub
son_satir = SK.Range("A:F").Find(What:="*", After:=SK.Cells(1, "A"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
SK.Cells(son_satir, "A") = SY.Range("C6")
SK.Cells(son_satir, "B") = SY.Range("C7")
SK.Cells(son_satir, "C") = SY.Range("H8")
SK.Cells(son_satir, "D") = SY.Range("A11")
SK.Cells(son_satir, "E") = SY.Range("F11")
SK.Cells(son_satir, "G") = SY.Range("A2")
For i = 2 To S1.[A65536].End(3).Row
If SY.Range("B1") = S1.Cells(i, "A") Then
sütun = WorksheetFunction.CountA(S1.Range("AE" & i & ":AM" & i))
If sütun = 10 Then
MsgBox " Sayfa1 de Tüm Sütunlar Dolu, Yazma İşlemi Gerçekleştirilemiyor ! ", vbCritical
Exit Sub
Else
sütun = sütun + 10
S1.Cells(i, sütun) = SY.Range("H11")
End If
End If
Next i
End Sub
 
. . .

If sütun = 9 Then ve
sütun = sütun + 31 olarak deneyiniz.

. . .
 
Teşekkürler tablom tamamdır emeği geçenlere saygılar.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst