Sayfayı farklı kaydetme işlemi

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

Sayfayı farklı kaydetme işlemi

İleti#1)  fenerbahcem » 09 Şub 2019 23:37

Arkadaşlar bu kod aynı kitaplık içine formülsüz kopyalama yapmaktadır.

Sub Kaydet()
For i = 1 To Sheets.Count
If Sheets(i).Name = CStr(Date) Then
MsgBox "Sayfa oluşturuldu.", vbCritical, "BAKINIZ !"
Exit Sub
End If
Next
Sheets("Ön yüz").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = Date
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
End Sub


Benim istediğim şöyledir.Bu makro Ön yüz isimli sayfayı sadece tarih olarak aynı çalışma kitabına kayıt yapmaktadır

1- Tarihe ilave olarak A8 ve D8 hücresindeki yazılan bilgileride yazdırıp kayıt yapabilsin
Örnek : 09.02.2019 - Ali Karabudak


2- Aşağıdaki makromuz formüllü ve makroları dakayıt yapıyorBen formülsüz ve makrosuz istiyorum.A8 ve D8 hücresindeki yazılan bilgileri alıp formülsüz kayıt yapabilsin ki böylece farklı kayıt yapıp, farklı kaydettiğim dosya üzerinden çalışmaya devam edebileyim.Aşağıdaki makroda fazlalık varsa kısaltalım lütfen

Sub Mahsup_Farklı_Kaydet()
Klasor = "C:\Users\Administrator\Desktop\"
Dosya_Adi = Worksheets("Ön yüz").Range("A8").Value ' dosya adı ve altta sayfa adı niçin iki kere azılmakktadır
Sayfa_Adı = "Ön yüz"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
uzanti = Right(ThisWorkbook.Name, InStr(1, StrReverse(ThisWorkbook.Name), ".", vbTextCompare))
If uzanti = ".xlsx" Then
FileFormatNum = 51
ElseIf uzanti = ".xlsm" Then
FileFormatNum = 52
ElseIf uzanti = ".xls" Then
FileFormatNum = -4143
ElseIf uzanti = ".xlsb" Then
FileFormatNum = 50
End If
Sheets(Sayfa_Adı).Copy
ActiveWorkbook.SaveAs Klasor & Dosya_Adi & uzanti, FileFormat:=FileFormatNum
ActiveWorkbook.Close SaveChanges:=False
MsgBox Klasor & Dosya_Adi & uzanti & " Dosya kayıt edildi"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

Yardım edenlere şimdiden teşekkür ederim..
Kullanıcı avatarı
fenerbahcem
Yeni Başlamış
 
Kayıt: 08 Kas 2015 15:04
Meslek: ev hanımı
Yaş: 29
İleti: 52
 
Cinsiyet: Bayan
Bulunduğunuz İl / Semt: Sinop

Cevap: Sayfayı farklı kaydetme işlemi

İleti#2)  Halil_61 » 10 Şub 2019 16:07

Merhaba, anladığım kadarı ile işleminizi yapabilmeniz için ve kopyalanan sayfayı da görebilmeniz gerekiyor. Öncelikle aktif sayfanız "Sheet1" olsun ve formülsüz olarak "sheet2" sayfasına kopyalamanız için aşağıdaki kodları Buton yardımıyla kullanın ve kendinize göre ayarlama yapabilirsiniz.
Kod: Tümünü seç
Sub GÖNDER_İŞLEMLERİ()
Application.ScreenUpdating = False
On Error Resume Next
Call GÖNDER_VERİLERİ_SİL
Call GÖNDER_SAYFASINA_VERİLERİ_AL
Application.ScreenUpdating = True
Sheets("Sheet1").Select

End Sub

Sub GÖNDER_VERİLERİ_SİL()
Sheets("Sheet2").Select
Application.ScreenUpdating = False
On Error Resume Next
    Range("a2:g60000").ClearContents
Application.ScreenUpdating = True

End Sub

Sub GÖNDER_SAYFASINA_VERİLERİ_AL()
Application.ScreenUpdating = False
On Error Resume Next
Set S1 = ThisWorkbook.Worksheets("Sheet1")
Set s2 = ThisWorkbook.Worksheets("Sheet2")
For i = 2 To 6000 'Kaçıncı satırdan başlayacağına karar ver.
For Z = 1 To 11   'Hangi sütun aralağını kopyalacağına karar ver.
s2.Cells(i, Z) = S1.Cells(i, Z)
Next Z
Next i
End Sub


Daha sonra aşağıdaki kodları yine buton yardımıyla çalıştırarak kayıt işlemini tamamlayabilirsiniz.

Kod: Tümünü seç
Sub Kaydet ()

' Y1 hücresine dosya adınızı yazın yada siz belirleyin.

If Sheet1.Cells(1, 25) = "" Then ' Eğer Y1 Boşsa makroyu kapatır.

MsgBox " Kayıt İşlemi Reddedildi.", vbInformation, "© Telif Hakkı 2018 Halil ASAN"

Else

Call GÖNDER_İŞLEMLERİ  ' sayfa kopyalama makrosunu çalıştırır.

On Error Resume Next

MkDir "\\sunucu\Ortak\Kargo_Takibi"  ' Klasor yok ise belirttiğiniz yolda otomatik klasor oluşturur.

'Klasor = [z1] & "\"

Application.ScreenUpdating = False
On Error Resume Next
Klasor = "\\sunucu\Ortak\Kargo_Takibi\" ' Belirttiğiniz Klasor yolunuzu yazınız.

Dosya_Adi = Date & " " & [y1] & " Gönderileri" ' Dosya adını günün tarihi ve y1 hücresine yazdığını dosya adı ile kayıt edecektir.
Sayfa_Adı = "Sheet2"


Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Set Sourcewb = ActiveWorkbook

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Dim wb As Workbook
Set wb = ActiveWorkbook

With wb
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else

If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
'MsgBox "HATA VAR"
FileExtStr = Right(Sourcewb.Name, 5)
FileFormatNum = 52
'Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xls": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xls": FileFormatNum = 52
Else
FileExtStr = ".xls": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xls": FileFormatNum = 50
End Select
End If
End If

End With

Dim ds, a
Set ds = CreateObject("Scripting.FileSystemObject")
a = ds.FileExists(Klasor & Dosya_Adi & FileExtStr)
If a = True Then
MsgBox "Bu isimde bir dosya var!"
'Exit Sub
Else

Dim sayfa As Worksheet
For Each sayfa In Worksheets
If sayfa.Name = Sayfa_Adı Then
sayfa.copy

ActiveWorkbook.SaveAs Klasor & Dosya_Adi & FileExtStr, FileFormat:=FileFormatNum
ActiveWorkbook.Close SaveChanges:=False
MsgBox Dosya_Adi & FileExtStr & " Dosya kayıt edildi"
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If

Next
End If


MsgBox "İşlem tamamlandı"

CreateObject("Shell.Application").Open Klasor & ad

Application.ScreenUpdating = False
On Error Resume Next
Range("y1:y6000").ClearContents
Application.ScreenUpdating = True

End If

End Sub


Kodların doğru çalışabilmesi için tarih formatı 10/02/2019 değil 10.02.2019 olmalıdır. Denetim masasından Bölge ve Dil seçeneklerinden değiştirebilirsiniz.
Kullanıcı avatarı
Halil_61
Siteye Alışmış
 
Adı Soyadı:Halil ASAN
Kayıt: 06 Nis 2013 21:24
Konum: İş
Meslek: Bilgi İşlem Uzmanı
Yaş: 31
İleti: 165
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Kadıköy

Cevap: Sayfayı farklı kaydetme işlemi

İleti#3)  şahin » 10 Şub 2019 16:09

Kod: Tümünü seç
Sub farkliKaydet()
Sheets("Ön Yüz").Copy
ActiveSheet.UsedRange.Copy
ActiveSheet.Range("a1").PasteSpecial xlPasteValues
ActiveWorkbook.SaveAs Filename:="C:\Users\Administrator\Desktop\" & Date & "-" & Sheets("Ön Yüz").Range("A8").Value2 & " " & Sheets("Ön Yüz").Range("D8").Value2 & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close 0
End Sub


Örnek Dosya

FarkliKaydet.rar
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
şahin
Site Dostu
 
Kayıt: 30 Eyl 2016 23:24
Meslek: memur
Yaş: 29
İleti: 525
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: bursa

Cevap: Sayfayı farklı kaydetme işlemi

İleti#4)  fenerbahcem » 10 Şub 2019 17:42

Sayın Halil Bey; Emek verdiğiniz için teşekkür ederim.
Sizin kodları hiç çalıştıramadım.Netice alamadım.

Sayın Şahin bey ; Emek verdiğiniz için teşekkür ederim.
Sizin kodlarınızda A1 hücresinden tarihi alıp formülleriyle birlikte kayıt yapmaktadır.

Lütfen sizden ricam şöyledir ;

Önyüz isimli şablon dosyamın içindeki bahsettiğim iki hücreden isimleri alıp otomatik tarih ekleyip
formülleri dikkate almayıp masaüstüne ve çalıştığım kitabın içine kayıt yaptırmak istiyorum.
Sağlıcakla kalın.
Kullanıcı avatarı
fenerbahcem
Yeni Başlamış
 
Kayıt: 08 Kas 2015 15:04
Meslek: ev hanımı
Yaş: 29
İleti: 52
 
Cinsiyet: Bayan
Bulunduğunuz İl / Semt: Sinop

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

Cevap: Sayfayı farklı kaydetme işlemi

İleti#5)  fenerbahcem » 10 Şub 2019 18:06

Şahin bey sizin verdiğiniz kodları gayet iyi çalışıyor dikkat etmemişim teşekkür ederim.
Kullanıcı avatarı
fenerbahcem
Yeni Başlamış
 
Kayıt: 08 Kas 2015 15:04
Meslek: ev hanımı
Yaş: 29
İleti: 52
 
Cinsiyet: Bayan
Bulunduğunuz İl / Semt: Sinop

Cevap: Sayfayı farklı kaydetme işlemi

İleti#6)  Halil_61 » 10 Şub 2019 18:23

Rica ederim, elimizden geldiğinde yardımcı oluyoruz. Dilerseniz ekte sizin için paylaşıyorum.Umarım işinize yarar.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
Halil_61
Siteye Alışmış
 
Adı Soyadı:Halil ASAN
Kayıt: 06 Nis 2013 21:24
Konum: İş
Meslek: Bilgi İşlem Uzmanı
Yaş: 31
İleti: 165
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Kadıköy

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Cevap: Sayfayı farklı kaydetme işlemi

İleti#7)  fenerbahcem » 11 Şub 2019 09:50

Halil_61 yazdı:Rica ederim, elimizden geldiğinde yardımcı oluyoruz. Dilerseniz ekte sizin için paylaşıyorum.Umarım işinize yarar.


Teşekkür ederim.
Kullanıcı avatarı
fenerbahcem
Yeni Başlamış
 
Kayıt: 08 Kas 2015 15:04
Meslek: ev hanımı
Yaş: 29
İleti: 52
 
Cinsiyet: Bayan
Bulunduğunuz İl / Semt: Sinop


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Google Adsense [Bot] ve 2 misafir

Bumerang - Yazarkafe