Birkaç Sayfayı Bilgisayara Kaydetme

ahmed_ummu

ahmed_ummu

Altın Üye
Katılım
28 Mart 2011
Mesajlar
722
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
Merhaba arkadaşlar.

Sheets("veri").Select
ActiveSheet.Copy
Application.Dialogs(xlDialogSaveAs).Show
ActiveWorkbook.Close

Yukarıdaki kod ile "veri" sayfasını bilgisayara kaydediyorum. Bu işimi görüyordu şimdi ise "PA_EK" "PA" "LÜZUMBELGESİ" ve "MTKK" sayfalarını da kaydetmem gerekiyor.

Bu sayfaları bir kitap içine kaydedebilir miyim. Bir de kitabın adını, MTKK sayfasının B6 hücresi ile PA sayfasındaki E5 hücresindeki verileri birleştirerek, masaüstündeki "SATINAMLA" klasörüne Farklı Kaydet diyalog kutusu çıkmadan kaydedilebilinir mi. Yardımcı olursanız çok sevinirim.
 
Asri

Asri

Katılım
24 Nisan 2005
Mesajlar
3,669
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Bu örnek üzerinden ilerlerseniz yapılır.

C#: 
Sub coklusayfakayit()
Set fso = CreateObject("scripting.filesystemobject")
Set wbmevcut = ActiveWorkbook
Sheets(Array("Sheet1", "Sheet3", "Sheet5")).Copy
Set wbkopya = ActiveWorkbook

yol = Environ("USERPROFILE") & "\Desktop\SATINALMA"
If Not fso.FileExists(yol) Then
   On Error Resume Next
   MkDir (yol)
   On Error GoTo 0
End If

isim = "Dosyaadi"

Application.DisplayAlerts = False
wbkopya.SaveAs yol & isim & ".xlsx"
Application.DisplayAlerts = True
wbkopya.Close
End Sub
 
ahmed_ummu

ahmed_ummu

Altın Üye
Katılım
28 Mart 2011
Mesajlar
722
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
Asri' Alıntı:
Bu örnek üzerinden ilerlerseniz yapılır.

C#: 
Sub coklusayfakayit()
Set fso = CreateObject("scripting.filesystemobject")
Set wbmevcut = ActiveWorkbook
Sheets(Array("Sheet1", "Sheet3", "Sheet5")).Copy
Set wbkopya = ActiveWorkbook

yol = Environ("USERPROFILE") & "\Desktop\SATINALMA"
If Not fso.FileExists(yol) Then
   On Error Resume Next
   MkDir (yol)
   On Error GoTo 0
End If

isim = "Dosyaadi"

Application.DisplayAlerts = False
wbkopya.SaveAs yol & isim & ".xlsx"
Application.DisplayAlerts = True
wbkopya.Close
End Sub
Genişletmek için tıkla ...
Yardımınız için çok teşekkürler sayın asri. Aşağıdaki gibi yaptım ama masaüstüne, kopyalanan sayfaların içinde bulunduğu ve yine sayfalardan bazı verilerin alınarak belirlenen bir isim ile bir kitap açıyor. Bir de boş bir "SATINALMA" klasörü açıyor. Açılan kitabı "SATINALMA" klasörünün içinde oluşturamaz mı.

Set fso = CreateObject("scripting.filesystemobject")
Set wbmevcut = ActiveWorkbook
Sheets(Array("PA", "PA_EK", "LÜZUMBELGESİ", "MKTT")).Copy
Set wbkopya = ActiveWorkbook

yol = Environ("USERPROFILE") & "\Desktop\SATINALMA"
If Not fso.FileExists(yol) Then
On Error Resume Next
MkDir (yol)
On Error GoTo 0
End If

isim = Sheets("MKTT").Range("b5").Value & " " & Sheets("MKTT").Range("b6").Value & " " & Sheets("MKTT").Range("b7").Value & " " & Sheets("MKTT").Range("b8").Value

Application.DisplayAlerts = False
wbkopya.SaveAs yol & isim & ".xlsx"
Application.DisplayAlerts = True
wbkopya.Close
 
Asri

Asri

Katılım
24 Nisan 2005
Mesajlar
3,669
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Denemedim ama bu şekilde deneyin.

C#: 
et fso = CreateObject("scripting.filesystemobject")
Set wbmevcut = ActiveWorkbook
Sheets(Array("PA", "PA_EK", "LÜZUMBELGESİ", "MKTT")).Copy
Set wbkopya = ActiveWorkbook

yol = Environ("USERPROFILE") & "\Desktop\SATINALMA"
If Not fso.FileExists(yol) Then
On Error Resume Next
MkDir (yol)
On Error GoTo 0
End If

isim = Sheets("MKTT").Range("b5").Value & " " & Sheets("MKTT").Range("b6").Value & " " & Sheets("MKTT").Range("b7").Value & " " & Sheets("MKTT").Range("b8").Value

Application.DisplayAlerts = False
[B]wbkopya.SaveAs yol & "\" & isim & ".xlsx"[/B]
Application.DisplayAlerts = True
wbkopya.Close
 
ahmed_ummu

ahmed_ummu

Altın Üye
Katılım
28 Mart 2011
Mesajlar
722
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
Asri' Alıntı:
Denemedim ama bu şekilde deneyin.

C#: 
et fso = CreateObject("scripting.filesystemobject")
Set wbmevcut = ActiveWorkbook
Sheets(Array("PA", "PA_EK", "LÜZUMBELGESİ", "MKTT")).Copy
Set wbkopya = ActiveWorkbook

yol = Environ("USERPROFILE") & "\Desktop\SATINALMA"
If Not fso.FileExists(yol) Then
On Error Resume Next
MkDir (yol)
On Error GoTo 0
End If

isim = Sheets("MKTT").Range("b5").Value & " " & Sheets("MKTT").Range("b6").Value & " " & Sheets("MKTT").Range("b7").Value & " " & Sheets("MKTT").Range("b8").Value

Application.DisplayAlerts = False
[B]wbkopya.SaveAs yol & "\" & isim & ".xlsx"[/B]
Application.DisplayAlerts = True
wbkopya.Close
Genişletmek için tıkla ...
İlginize çok teşekkürler sayın Asri.

Eklediğim resimdeki gibi hata verdi.

Yardımcı olursanız bişey daha sormak istiyorum. Sayfaları kaydederken dosya türünü "Excel 97-2003 Çalışma Kitabı" olarak kaydedebilir mi.

Yardımlarının içim şimdiden teşekkürler.
 

Ekli dosyalar

Asri

Asri

Katılım
24 Nisan 2005
Mesajlar
3,669
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Enteresan, kodun başını ve sonunu yapıştırmamışım.

Sizin sayfa yapınıza göre düzenlendi. Test edildi.
Office 2003 olarak kayıt yapılacak.

C#: 
Sub coklusayfakayit()
Set fso = CreateObject("scripting.filesystemobject")
Set wbmevcut = ActiveWorkbook
Sheets(Array("PA", "PA_EK", "LÜZUMBELGESİ", "MKTT")).Copy
Set wbkopya = ActiveWorkbook

yol = Environ("USERPROFILE") & "\Desktop\SATINALMA"
If Not fso.FileExists(yol) Then
   On Error Resume Next
   MkDir (yol)
   On Error GoTo 0
End If

isim = Sheets("MKTT").Range("b5").Value & " " & Sheets("MKTT").Range("b6").Value & " " & Sheets("MKTT").Range("b7").Value & " " & Sheets("MKTT").Range("b8").Value


Application.DisplayAlerts = False
wbkopya.SaveAs yol & "\" & isim & ".xls", FileFormat:=56
Application.DisplayAlerts = True
wbkopya.Close
End Sub
 
ahmed_ummu

ahmed_ummu

Altın Üye
Katılım
28 Mart 2011
Mesajlar
722
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
Asri' Alıntı:
Enteresan, kodun başını ve sonunu yapıştırmamışım.

Sizin sayfa yapınıza göre düzenlendi. Test edildi.
Office 2003 olarak kayıt yapılacak.

C#: 
Sub coklusayfakayit()
Set fso = CreateObject("scripting.filesystemobject")
Set wbmevcut = ActiveWorkbook
Sheets(Array("PA", "PA_EK", "LÜZUMBELGESİ", "MKTT")).Copy
Set wbkopya = ActiveWorkbook

yol = Environ("USERPROFILE") & "\Desktop\SATINALMA"
If Not fso.FileExists(yol) Then
   On Error Resume Next
   MkDir (yol)
   On Error GoTo 0
End If

isim = Sheets("MKTT").Range("b5").Value & " " & Sheets("MKTT").Range("b6").Value & " " & Sheets("MKTT").Range("b7").Value & " " & Sheets("MKTT").Range("b8").Value


Application.DisplayAlerts = False
wbkopya.SaveAs yol & "\" & isim & ".xls", FileFormat:=56
Application.DisplayAlerts = True
wbkopya.Close
End Sub
Genişletmek için tıkla ...
Çok teşekkürler sayın Asri elinize sağlık, iyi akşamlar.
 
F

fikretac

Altın Üye
Katılım
23 Eylül 2023
Mesajlar
19
Excel Vers. ve Dili
Turkce
Altın Üyelik Bitiş Tarihi
19-11-2024
Sayın Asri bu makroyu kendi belgeme uyarlamaya calıstim fakat yapamadım.
Excel belgesi icindeki A,B,C,D isimli 4 sayfayı formulsüz olarak kopyalayıp aynı belgedeki MİATLI sayfası B5 hücresindeki isme göre xls formatinda tek belge olarak masaüstüne kayıt yaptırmak istiyorum. Yardimcı olabilirmisiniz.
 
Son düzenleme:
Asri

Asri

Katılım
24 Nisan 2005
Mesajlar
3,669
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Bu şekilde dener misiniz? masa üstüne kaydedecektir.

C#: 
Sub coklusayfakayit()
Set fso = CreateObject("scripting.filesystemobject")
Set wbmevcut = ActiveWorkbook
    isim = wbmevcut.Sheets("MİATLI").Range("B5").Value

    Sheets(Array("A", "B", "C", "D")).Copy
    Set wbkopya = ActiveWorkbook
    
    wbkopya.Sheets("A").Cells.Copy
    wbkopya.Sheets("A").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

    wbkopya.Sheets("B").Cells.Copy
    wbkopya.Sheets("B").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    wbkopya.Sheets("C").Cells.Copy
    wbkopya.Sheets("C").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    wbkopya.Sheets("D").Cells.Copy
    wbkopya.Sheets("D").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    yol = Environ("USERPROFILE") & "\Desktop"
    If Not fso.FileExists(yol) Then
       On Error Resume Next
       MkDir (yol)
       On Error GoTo 0
    End If
    
    Application.DisplayAlerts = False
    wbkopya.SaveAs yol & "\" & isim & ".xls", FileFormat:=56
    Application.DisplayAlerts = True
    wbkopya.Close
End Sub
 
F

fikretac

Altın Üye
Katılım
23 Eylül 2023
Mesajlar
19
Excel Vers. ve Dili
Turkce
Altın Üyelik Bitiş Tarihi
19-11-2024
Sayın Asri elinize sağlık cok teşekkür ederim
 
F

fikretac

Altın Üye
Katılım
23 Eylül 2023
Mesajlar
19
Excel Vers. ve Dili
Turkce
Altın Üyelik Bitiş Tarihi
19-11-2024
Merhaba arkadaşlar
Excel 2016 da hazırladığım kitapta asagidaki makro calısıyor fakat 2016 kullanan başka pc yüklediğimde makro kopyalıyor ancak farklı kaydet penceresi acılarak kaydedilecek yeri ve kitap ismini soruyor. Bu neden olabilir. Tsl ederim.

Sub coklusayfakayit_haftalık()
Set fso = CreateObject("scripting.filesystemobject")
Set wbmevcut = ActiveWorkbook
isim = wbmevcut.Sheets("MİATLI").Range("F13").Value
Sheets("HAFTALIK").Unprotect Password:="55"
Sheets(Array("HAFTALIK")).Copy
Set wbkopya = ActiveWorkbook
wbkopya.Sheets("HAFTALIK").Cells.Copy
wbkopya.Sheets("HAFTALIK").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
yol = Environ("USERPROFILE") & "\Desktop"
If Not fso.FileExists(yol) Then
On Error Resume Next
MkDir (yol)
On Error GoTo 0
End If
Application.DisplayAlerts = False
wbkopya.SaveAs yol & "\" & isim & ".xls", FileFormat:=56
Application.DisplayAlerts = True
wbkopya.Close
Sheets("HAFTALIK").Protect Password:="55"
End Sub
 
Asri

Asri

Katılım
24 Nisan 2005
Mesajlar
3,669
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
fikretac' Alıntı:
Merhaba arkadaşlar
Excel 2016 da hazırladığım kitapta asagidaki makro calısıyor fakat 2016 kullanan başka pc yüklediğimde makro kopyalıyor ancak farklı kaydet penceresi acılarak kaydedilecek yeri ve kitap ismini soruyor. Bu neden olabilir. Tsl ederim.

Sub coklusayfakayit_haftalık()
Set fso = CreateObject("scripting.filesystemobject")
Set wbmevcut = ActiveWorkbook
isim = wbmevcut.Sheets("MİATLI").Range("F13").Value
Sheets("HAFTALIK").Unprotect Password:="55"
Sheets(Array("HAFTALIK")).Copy
Set wbkopya = ActiveWorkbook
wbkopya.Sheets("HAFTALIK").Cells.Copy
wbkopya.Sheets("HAFTALIK").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
yol = Environ("USERPROFILE") & "\Desktop"
If Not fso.FileExists(yol) Then
On Error Resume Next
MkDir (yol)
On Error GoTo 0
End If
Application.DisplayAlerts = False
wbkopya.SaveAs yol & "\" & isim & ".xls", FileFormat:=56
Application.DisplayAlerts = True
wbkopya.Close
Sheets("HAFTALIK").Protect Password:="55"
End Sub
Genişletmek için tıkla ...
yol dan kaynaklı bir sorun olabilir. Buradaki bilgiyi
yol = Environ("USERPROFILE") & "\Desktop"

Bu şekilde değiştirip deneyebilir misiniz.
yol ="C:\deneme"
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst