[Yardım]  Değer Olarak Kopyala ve Kaydet

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Değer Olarak Kopyala ve Kaydet

İleti#1)  Metin1981 » 17 Nis 2018 09:19

İyi günler ekli dosyada dikili girişi sayfasında D15:I20000 hücre aralığındaki verileri buton ile değer olarak yeni bir excel dosyasında DikiliDamga sayfası adı altında bir sayfa oluşturup ;bu sayfa içerisinde A2:M hücre aralığına değer olarak kopyalayıp; Dikili Girişi sayfasında P13 Hücresindeki adla masa üstüne kayıt yapabilir miyiz. Yardımcı Olur musunuz .?
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
Metin1981
Site Dostu
 
Adı Soyadı:Metin KOT
Kayıt: 21 Haz 2012 10:29
Konum: Samsun
Meslek: Memur
Yaş: 39
İleti: 556
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya

Cevap: Değer Olarak Kopyala ve Kaydet

İleti#2)  hemso41 » 17 Nis 2018 11:14

Bir mdoül ekleyip aşağıdaki kodları içine yapıştırınız.
Kod: Tümünü seç
Sub kopyala()
    Sayfa1.Range("D15:I20000").Copy
    Workbooks.Add
    Sheets("Sayfa1").Select
    Sheets("Sayfa1").Name = "DikiliDamga"
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:="C:\Users\serdar\Desktop\" & Sayfa1.Range("p13") & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub

Kopyala butonuna sağ tuş makro ata ile kopyala makrosunu atayınız.Masaüstü yolunuzu yukarıda düzenleyiniz.
Kullanıcı avatarı
hemso41
Siteye Alışmış
 
Kayıt: 22 Eyl 2015 10:04
Meslek: BİLGİ İŞLEM
Yaş: 38
İleti: 317
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir/karşıyaka

Cevap: Değer Olarak Kopyala ve Kaydet

İleti#3)  Metin1981 » 17 Nis 2018 11:30

Sayın Hocam sayfayı kayıt yapmıyor.Şu hata oluşuyor.Ayrıca değer olarak kopyalamıyor.Tümünü kopyalıyor.Formül ve tablo ile birlikte sadece değer olarak kopyalasın.
ActiveWorkbook.SaveAs Filename:="C:\Users\serdar\Desktop\" & Sayfa1.Range("p13") & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Kullanıcı avatarı
Metin1981
Site Dostu
 
Adı Soyadı:Metin KOT
Kayıt: 21 Haz 2012 10:29
Konum: Samsun
Meslek: Memur
Yaş: 39
İleti: 556
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya

Cevap: Değer Olarak Kopyala ve Kaydet

İleti#4)  hemso41 » 17 Nis 2018 12:38

Değerli arkadaşım dosya yolunu düzenle demiştim.
"C:\Users\serdar\Desktop\"
bu benim bilgisayarın masaüstü yolu sizinki de değiştirip revize ediniz.
Kullanıcı avatarı
hemso41
Siteye Alışmış
 
Kayıt: 22 Eyl 2015 10:04
Meslek: BİLGİ İŞLEM
Yaş: 38
İleti: 317
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir/karşıyaka

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Değer Olarak Kopyala ve Kaydet

İleti#5)  Metin1981 » 17 Nis 2018 12:54

Teşekkür ederim.Veriyi formül ve tablo ile birlikte kopyalıyor.Bunu değer olarak kopyalamasını nasıl yaparız.Yeni dosya kayıt yapıldıktan sonra ana dosya ile birlikte açık kalıyor.Kapana bilir mi?
Kullanıcı avatarı
Metin1981
Site Dostu
 
Adı Soyadı:Metin KOT
Kayıt: 21 Haz 2012 10:29
Konum: Samsun
Meslek: Memur
Yaş: 39
İleti: 556
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya

Cevap: Değer Olarak Kopyala ve Kaydet

İleti#6)  Metin1981 » 17 Nis 2018 15:25

Sayın hocam sadece değerlerin kopyalanması makrosunu hallettim.Ancak kopyalayınca dosyadan çıkmıyor.Eğer aynı dosyadan masa üstünde varsa onu sormadan üzerine kayıt yapabilir mi acaba
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
Metin1981
Site Dostu
 
Adı Soyadı:Metin KOT
Kayıt: 21 Haz 2012 10:29
Konum: Samsun
Meslek: Memur
Yaş: 39
İleti: 556
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Değer Olarak Kopyala ve Kaydet

İleti#7)  hemso41 » 17 Nis 2018 16:34

Kod: Tümünü seç
masaüstünü yolunu revize edip aşağıdaki kodu modülün içerisine yapıştırınız.
Sub kopyala()
Application.DisplayAlerts = False
    Sayfa1.Range("D15:I20000").Copy
    Workbooks.Add
    Sheets("Sayfa1").Select
    Sheets("Sayfa1").Name = "DikiliDamga"
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
      ActiveWorkbook.SaveAs Filename:="C:\Users\serdar\Desktop\" & Sayfa1.Range("p13") & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
Application.DisplayAlerts = True
End Sub
Kullanıcı avatarı
hemso41
Siteye Alışmış
 
Kayıt: 22 Eyl 2015 10:04
Meslek: BİLGİ İŞLEM
Yaş: 38
İleti: 317
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir/karşıyaka

Cevap: Değer Olarak Kopyala ve Kaydet

İleti#8)  Metin1981 » 17 Nis 2018 17:06

Allah razı olsun sizden çok güzel çalışıyor.Yalnız birşey sormak istiyorum.Kayıt yapılan yeni dosyada A sütünü Tarih olması gerekirken sayı atıyor.Bunu tarih olarak atabilir mi?
Kullanıcı avatarı
Metin1981
Site Dostu
 
Adı Soyadı:Metin KOT
Kayıt: 21 Haz 2012 10:29
Konum: Samsun
Meslek: Memur
Yaş: 39
İleti: 556
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya

Cevap: Değer Olarak Kopyala ve Kaydet

İleti#9)  Metin1981 » 17 Nis 2018 18:47

Allah razı olsun sizden çok güzel çalışıyor.Yalnız birşey sormak istiyorum.Kayıt yapılan yeni dosyada A sütünü Tarih olması gerekirken sayı atıyor.Bunu tarih olarak atabilir mi?.Birde dosya yolunu makro otomatik masaüstü seçebilir mi?.Çünkü devamlı başka bilgi sayarlarda çalışıldığı için
Kullanıcı avatarı
Metin1981
Site Dostu
 
Adı Soyadı:Metin KOT
Kayıt: 21 Haz 2012 10:29
Konum: Samsun
Meslek: Memur
Yaş: 39
İleti: 556
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya

Cevap: Değer Olarak Kopyala ve Kaydet

İleti#10)  hemso41 » 17 Nis 2018 23:29

Modül içindeki tüm kodlarınızı aşağıdaki gibi revize ediniz.Allah cc hepimizden razı olsun inşallah.
Kod: Tümünü seç
Sub kopyala()
yol = masaustubul()

Application.DisplayAlerts = False
    Sayfa1.Range("D15:I20000").Copy
    Workbooks.Add
    Sheets("Sayfa1").Select
    Sheets("Sayfa1").Name = "DikiliDamga"
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormat = "m/d/yyyy"
      ActiveWorkbook.SaveAs Filename:=yol & "\" & Sayfa1.Range("p13") & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
Application.DisplayAlerts = True
End Sub

Function masaustubul() As String
     Set kod = CreateObject("WScript.Shell")
     masaustubul = kod.SpecialFolders("Desktop")
        Set kod = Nothing
    Exit Function

End Function
Kullanıcı avatarı
hemso41
Siteye Alışmış
 
Kayıt: 22 Eyl 2015 10:04
Meslek: BİLGİ İŞLEM
Yaş: 38
İleti: 317
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir/karşıyaka

Cevap: Değer Olarak Kopyala ve Kaydet

İleti#11)  Metin1981 » 18 Nis 2018 01:47

Tekrar tekrar çok teşekkür ederim.Ellerinize sağlık.Devamlı yeni bir şey ekleyerek sizi zahmete soktuğum için özür diliyorum.Son olarak şöyle bir şey olabilir mi?.
Eğer Masaüstünde "DAMGALARIM" İsminde bir klasör var ise yeni dosya bu klasörün içine kayıt yapılabilirmi?.Eğer DAMGALARIM klasörü yok ise DAMGALARIM isimli bir klasör oluşturup , oluşturulan klasörün içerisne kayıt yapılablir mi?
Kullanıcı avatarı
Metin1981
Site Dostu
 
Adı Soyadı:Metin KOT
Kayıt: 21 Haz 2012 10:29
Konum: Samsun
Meslek: Memur
Yaş: 39
İleti: 556
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya

Cevap: Değer Olarak Kopyala ve Kaydet

İleti#12)  hemso41 » 18 Nis 2018 11:27

Artık bu son olur inşallah.
Kod: Tümünü seç
Sub kopyala()
yol = masaustubul()

Application.DisplayAlerts = False
    Sayfa1.Range("D15:I20000").Copy
    Workbooks.Add
    Sheets("Sayfa1").Select
    Sheets("Sayfa1").Name = "DikiliDamga"
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormat = "m/d/yyyy"
        If Dir(yol & "\DAMGALARIM", vbDirectory) = "" Then
            MkDir (yol & "\DAMGALARIM")
        End If
          ActiveWorkbook.SaveAs Filename:=yol & "\DAMGALARIM\" & Sayfa1.Range("p13") & ".xlsx", _
            FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWindow.Close
Application.DisplayAlerts = True
End Sub

Function masaustubul() As String
     Set kod = CreateObject("WScript.Shell")
     masaustubul = kod.SpecialFolders("Desktop")
        Set kod = Nothing
    Exit Function

End Function
Kullanıcı avatarı
hemso41
Siteye Alışmış
 
Kayıt: 22 Eyl 2015 10:04
Meslek: BİLGİ İŞLEM
Yaş: 38
İleti: 317
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir/karşıyaka

Cevap: Değer Olarak Kopyala ve Kaydet

İleti#13)  Metin1981 » 18 Nis 2018 12:07

Teşekkür ederim.Son olarak aşağıdaki kodun D15:I20000 hücre aralığındaki tümünü değilde sadece bu aralıkta dolu satırı kopyalayabilir miyiz?.

Sayfa1.Range("D15:I20000").Copy
Kullanıcı avatarı
Metin1981
Site Dostu
 
Adı Soyadı:Metin KOT
Kayıt: 21 Haz 2012 10:29
Konum: Samsun
Meslek: Memur
Yaş: 39
İleti: 556
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya

Cevap: Değer Olarak Kopyala ve Kaydet

İleti#14)  hemso41 » 18 Nis 2018 13:23

Kod: Tümünü seç
Sayfa1.Range("D15:I20000").Copy

yerine
Kod: Tümünü seç
set rng=Range("D15:I20000")
Union(rng.SpecialCells(xlCellTypeConstants), rng.SpecialCells(xlCellTypeFormulas)).copy

yazabilirsiniz.
Kullanıcı avatarı
hemso41
Siteye Alışmış
 
Kayıt: 22 Eyl 2015 10:04
Meslek: BİLGİ İŞLEM
Yaş: 38
İleti: 317
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir/karşıyaka

Cevap: Değer Olarak Kopyala ve Kaydet

İleti#15)  Metin1981 » 18 Nis 2018 13:29

Kod hata verdi.
Kullanıcı avatarı
Metin1981
Site Dostu
 
Adı Soyadı:Metin KOT
Kayıt: 21 Haz 2012 10:29
Konum: Samsun
Meslek: Memur
Yaş: 39
İleti: 556
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya

Cevap: Değer Olarak Kopyala ve Kaydet

İleti#16)  Metin1981 » 18 Nis 2018 13:30

Hata verdi
Sub kopyala()
yol = masaustubul()

Application.DisplayAlerts = False
Set Rng = Range("D15:I20000")
Union(Rng.SpecialCells(xlCellTypeConstants), Rng.SpecialCells(xlCellTypeFormulas)).Copy
Workbooks.Add
Sheets("Sayfa1").Select
Sheets("Sayfa1").Name = "DikiliDamga"
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "m/d/yyyy"
If Dir(yol & "\DAMGALARIM", vbDirectory) = "" Then
MkDir (yol & "\DAMGALARIM")
End If
ActiveWorkbook.SaveAs Filename:=yol & "\DAMGALARIM\" & Sayfa1.Range("Q3") & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Application.DisplayAlerts = True
End Sub

Function masaustubul() As String
Set kod = CreateObject("WScript.Shell")
masaustubul = kod.SpecialFolders("Desktop")
Set kod = Nothing
Exit Function

End Function
Kullanıcı avatarı
Metin1981
Site Dostu
 
Adı Soyadı:Metin KOT
Kayıt: 21 Haz 2012 10:29
Konum: Samsun
Meslek: Memur
Yaş: 39
İleti: 556
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya

Cevap: Değer Olarak Kopyala ve Kaydet

İleti#17)  hemso41 » 18 Nis 2018 15:02

Bu son olur inşallah...
Kod: Tümünü seç
Sub kopyala()
yol = masaustubul()

Application.DisplayAlerts = False
Set Rng = Range("D15:I20000")

    Set bossutun = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).EntireColumn.Offset(0, 1)
    Intersect(Rng.EntireRow, bossutun) = Evaluate("IF(" & Rng.Address & "="""","""",""X"")")
    Intersect(bossutun.SpecialCells(xlConstants).EntireRow, Rng.EntireColumn).Copy

Workbooks.Add
Sheets("Sayfa1").Select
Sheets("Sayfa1").Name = "DikiliDamga"
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "m/d/yyyy"
If Dir(yol & "\DAMGALARIM", vbDirectory) = "" Then
MkDir (yol & "\DAMGALARIM")
End If
ActiveWorkbook.SaveAs Filename:=yol & "\DAMGALARIM\" & Sayfa1.Range("p13") & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Application.DisplayAlerts = True
End Sub

Function masaustubul() As String
Set kod = CreateObject("WScript.Shell")
masaustubul = kod.SpecialFolders("Desktop")
Set kod = Nothing
Exit Function

End Function


Kullanıcı avatarı
hemso41
Siteye Alışmış
 
Kayıt: 22 Eyl 2015 10:04
Meslek: BİLGİ İŞLEM
Yaş: 38
İleti: 317
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir/karşıyaka

Cevap: Değer Olarak Kopyala ve Kaydet

İleti#18)  Metin1981 » 18 Nis 2018 15:10

Bu kod hata veriyor.

Kod: Tümünü seç
Intersect(Rng.EntireRow, bossutun) = Evaluate("IF(" & Rng.Address & "="""","""",""X"")")
Kullanıcı avatarı
Metin1981
Site Dostu
 
Adı Soyadı:Metin KOT
Kayıt: 21 Haz 2012 10:29
Konum: Samsun
Meslek: Memur
Yaş: 39
İleti: 556
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya

Cevap: Değer Olarak Kopyala ve Kaydet

İleti#19)  hemso41 » 18 Nis 2018 15:20

rnek.rar

bende sorunsuz çalışıyor...
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
hemso41
Siteye Alışmış
 
Kayıt: 22 Eyl 2015 10:04
Meslek: BİLGİ İŞLEM
Yaş: 38
İleti: 317
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir/karşıyaka

Cevap: Değer Olarak Kopyala ve Kaydet

İleti#20)  Metin1981 » 18 Nis 2018 15:45

Çok teşekkür ederim.Ellerinize sağlık
Kullanıcı avatarı
Metin1981
Site Dostu
 
Adı Soyadı:Metin KOT
Kayıt: 21 Haz 2012 10:29
Konum: Samsun
Meslek: Memur
Yaş: 39
İleti: 556
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 4 misafir

Bumerang - Yazarkafe