• DİKKAT

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

Sayfaları macro ile ayrı ayrı excel dosya haline getirme

S

search77

Katılım
21 Temmuz 2006
Mesajlar
322
Arkadaşlar merhaba,

Ekli örenek dosyamdaki sayfaları ayrı ayrı excel dosya olarak nasıl kaydedebilirim.

Yani bunu macro ile nasıl yapabilirim.

Yardımcı olacak arkadaşlara şimdiden çok çok tşk ederim.

Saygılarımla.
 

Ekli dosyalar

Merhaba,

Module kopyalayarak çalıştırınız.

Kod: 
Sub SayfaKaydet()
 
Application.ScreenUpdating = False
 
For i = 1 To Sheets.Count
 
    Sheets(i).Select
    dosya = CreateObject("Wscript.Shell").SpecialFolders.Item("Desktop") & _
    Application.PathSeparator & Sheets(i).[H2] & ".xls"
 
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=dosya
    ActiveWorkbook.Close
 
Next i
 
Application.ScreenUpdating = True
 
End Sub
.
 
Ömer bey harika olmuş elinize sağlık,

Acaba dosyları direk masaüstüne değilde masaüstünde "Dosya" klasörü oluşturdum, onun içine kaydetmesi mümkün mü?

Macroyu bu şekilde yazabilir miyiz?

Çok tşk ederim.
 
Bu şekilde deneyiniz.

Kod: 
Sub SayfaKaydet()
 
Application.ScreenUpdating = False
 
For i = 1 To Sheets.Count
 
    Sheets(i).Select
    dosya = CreateObject("Wscript.Shell").SpecialFolders.Item("Desktop") & _
    [COLOR=black]"\[COLOR=red]Dosya[/COLOR]" &[/COLOR] Application.PathSeparator & Sheets(i).[H2] & ".xls"
 
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=dosya
    ActiveWorkbook.Close
 
Next i
 
Application.ScreenUpdating = True
 
End Sub
.
 
Mükemmel mükemmel mükemmelsiniz.

Çok tşk ederim ömer bey.

Saygı ve sevgilerimle.
 
Rica ederim, iyi çalışmalar.

Saygı ve Sevgilerimle..

.
 
Ömer' Alıntı:
Rica ederim, iyi çalışmalar.

Saygı ve Sevgilerimle..

.
Genişletmek için tıkla ...

İyi günler Grup üyeleri;
sabah 05:36 'da yazıyorum çünkü bu saate kadar sorunum çözümünü maalesef bulamadım;umarım çözüm sizdedir;
TABLO sayfamda
A5ten başlayarak a2000 lere kadar:TC Kimlik no:
b5 ten başlayarak b2000 lere kadar Ad-Soyad
c5 " " " İşin niteliği
d5 " " " görevi
e5 " " " eğitim durumu
f5 " " " durumu
g5 " " " Mülakat durumu
h5 " " " sınava katılım
ı5 " " " sınav sonucu değerlerim var.
Bu değerler ile belirlenen formatta başka bir sayfada (aynı dosya içinde bu arada bunlar)VERİ sayfamda a9 alanına TC kimlik noyu giriyorum ; diğer alanlar düşeyara formulu ile 1 kişinin tüm değerlerini getiriyorum.Oluşturduğum tek kişiye ait VERİ sayfasını TAŞI veya KOPYALA komutu ile yeni sayfaya kopyalıyorum.Tüm formulleri değere çeviriyorum.Farklı kaydet komutu ile masaüstündeki Personel Klasörüne ad-soyad olarak kaydediyorum.(Ad-soyad sayfada b9 alanında)Tüm bu işlemlerin manuel olarak yürütülmesi gerçekten çok zaman alıyor ve aynı zamanda hataya da çok açık.Umarım yardımlarınız sayesinde bu sorunu da atlatacağım.
Yardımlarınız için şimdiden teşekkürler.
 
Merhaba,

2 Kod yapısından size uygun olanı kullanırsınız.

Tekli kayıt:
Burada; A9 hücresini siz değiştirirsiniz ve istediğiniz zaman kaydet yaparak sadece A9 daki verilere göre ilgili kişiyi Personel klasörüne kaydeder.

Kod: 
Sub Kaydet_Tekli()
 
    Dim dosya As String
    
    Application.ScreenUpdating = False
    Sheets("VERİ").Select
    
    Application.DisplayAlerts = False
    dosya = CreateObject("Wscript.Shell").SpecialFolders.Item("Desktop") & _
    "\Personel\" & [B9] & ".xlsx"

    ActiveSheet.Copy
    Cells.Copy
    Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Application.CutCopyMode = False
    Range("A9").Select
    ActiveWorkbook.SaveAs Filename:=dosya
    ActiveWorkbook.Close
    
    MsgBox "İşleminiz Tamamlandı", , "excel.web.tr"
    Application.ScreenUpdating = True
 
End Sub

Çoklu kayıt:
Burada; Tablo sayfasındaki tüm değerleri Veri sayfasına sırayla otomatik alarak Personel klasörüne kaydeder.
Not: Tüm değerleri aynı anda kaydedeceği için değer sayısına göre işlem uzun sürebilir, kodun işlemi tamamlamasını bekleyiniz.

Kod: 
Sub Kaydet_Coklu()
 
    Dim St As Worksheet, i As Long, dosya As String
    
    Set St = Sheets("TABLO")
    
    Application.ScreenUpdating = False
    Sheets("VERİ").Select
    
    Application.DisplayAlerts = False
    For i = 5 To St.Cells(Rows.Count, "A").End(xlUp).Row
        
        Range("A9") = St.Cells(i, "A")
        
        dosya = CreateObject("Wscript.Shell").SpecialFolders.Item("Desktop") & _
        "\Personel\" & [B9] & ".xlsx"
        
        ActiveSheet.Copy
        Cells.Copy
        Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
        Application.CutCopyMode = False
        Range("A9").Select
        ActiveWorkbook.SaveAs Filename:=dosya
        ActiveWorkbook.Close
        
    Next i
    
    MsgBox "İşleminiz Tamamlandı", , "excel.web.tr"
    Application.ScreenUpdating = True
 
End Sub

.
 
Sayın Ömer ;çok ama çok teşekkür ederim; uykusuz geçen bir geceden sonra ilaç oldunuz.toplu makro ile şuan çözdüm sanki.tekrar çok ama çok teşekkürler, emeğinize sağlık.
 
Excel veri girişi ve pdf yaparak mail atma

Merhaba Ömer Bey benim sorunum ekte sipariş teyit formu adlı dosyada verileri girdiğim bir sayfa var.İstediğim dosyada yer alan Sipariş Teyid Formuna göndermek istediğim siparişi seçtiğimde makro ile bilgileri otomatik getirmesini istiyorum.Ayrıca Sipariş Teyit Formunu pdf formatına çevirip mail atmak istiyorum.
 

Ekli dosyalar

tekirdagli_0059' Alıntı:
Sayın Ömer ;çok ama çok teşekkür ederim; uykusuz geçen bir geceden sonra ilaç oldunuz.toplu makro ile şuan çözdüm sanki.tekrar çok ama çok teşekkürler, emeğinize sağlık.
Genişletmek için tıkla ...

Rica ederim. İşinize yaradığına sevindim.

hb3102' Alıntı:
Merhaba Ömer Bey benim sorunum ekte sipariş teyit formu adlı dosyada verileri girdiğim bir sayfa var.İstediğim dosyada yer alan Sipariş Teyid Formuna göndermek istediğim siparişi seçtiğimde makro ile bilgileri otomatik getirmesini istiyorum.Ayrıca Sipariş Teyit Formunu pdf formatına çevirip mail atmak istiyorum.
Genişletmek için tıkla ...

Merhaba,

Sayfa aktarımı için ara yerine aşağıdaki formül yapısını kullanın.

Kod: 
=İNDİS('Veri Girişi'!D:D;KAÇINCI('Veri Girişi'!A3;'Veri Girişi'!C:C;0))

D: D yerine F:F yazarsanız F sütunundaki değeri getirir.

Mail için:

Kod: 
Sub Mail_At()

    Dim OutApp As Object, OutMail As Object, FSO As Object, MySignature As Object
    Dim baslik As String, metin As String, yol As String, dosya As String

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    
    Set FSO = CreateObject("Scripting.FilesystemObject")
    
    yol = CreateObject("Wscript.Shell").SpecialFolders.Item("Desktop") & Application.PathSeparator
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        yol & "\" & [D13] & "_" & Format(Now, "dd.mm.yy_hh.nn") & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False ', OpenAfterPublish:=True
    
    baslik = "Sipariş_Listesi"
    metin = "Sayın Yetkili," & Chr(10) & "Ekteki Siparişleri En Kısa Sürede Tarafımıza " _
        & "Ulaştırmanızı Rica Ederiz." & Chr(10) & "İyi Çalışmalar"
        
    dosya = yol & "\" & [D13] & "_" & Format(Now, "dd.mm.yy_hh.nn") & ".pdf"
  
    On Error Resume Next
    With OutMail
        .To = "" 'bu bölüme firma mail adresini yazın.
        .CC = "" 'bu bölüme bilgi için gönderilecek mail adresini yazın.
        .Subject = baslik
        .Body = metin
        .Attachments.Add dosya
        .Display
        '.Send
    End With
    On Error GoTo 0

    Kill dosya
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    
End Sub

.
 
Ömer' Alıntı:
Rica ederim. İşinize yaradığına sevindim.



Merhaba,

Sayfa aktarımı için ara yerine aşağıdaki formül yapısını kullanın.

Kod: 
=İNDİS('Veri Girişi'!D:D;KAÇINCI('Veri Girişi'!A3;'Veri Girişi'!C:C;0))

D: D yerine F:F yazarsanız F sütunundaki değeri getirir.

Mail için:

Kod: 
Sub Mail_At()

    Dim OutApp As Object, OutMail As Object, FSO As Object, MySignature As Object
    Dim baslik As String, metin As String, yol As String, dosya As String

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    
    Set FSO = CreateObject("Scripting.FilesystemObject")
    
    yol = CreateObject("Wscript.Shell").SpecialFolders.Item("Desktop") & Application.PathSeparator
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        yol & "\" & [D13] & "_" & Format(Now, "dd.mm.yy_hh.nn") & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False ', OpenAfterPublish:=True
    
    baslik = "Sipariş_Listesi"
    metin = "Sayın Yetkili," & Chr(10) & "Ekteki Siparişleri En Kısa Sürede Tarafımıza " _
        & "Ulaştırmanızı Rica Ederiz." & Chr(10) & "İyi Çalışmalar"
        
    dosya = yol & "\" & [D13] & "_" & Format(Now, "dd.mm.yy_hh.nn") & ".pdf"
  
    On Error Resume Next
    With OutMail
        .To = "" 'bu bölüme firma mail adresini yazın.
        .CC = "" 'bu bölüme bilgi için gönderilecek mail adresini yazın.
        .Subject = baslik
        .Body = metin
        .Attachments.Add dosya
        .Display
        '.Send
    End With
    On Error GoTo 0

    Kill dosya
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    
End Sub

.
Genişletmek için tıkla ...


Sayın Ömer ;
dün çalıştırdığımda dikkat etmemiştim ; bugün kontroller sırasında atladığım bir konu olduğunu farkettim,E9 hücresindeki Eğitim durumuna göre a12'de açılır menü yapmıştım ve E9 hücresine = ile bağlamıştım.E9 hücresi her değiştiğinde a12 deki seçenek de değişiyor.A12 deki açılır pencere de aynı çalışma kitabının Sayfa4 kısmında a1den başlayarak V1 e kadar öğrenim durumları var;a2den başlayarak v13 'e kadar da her başlığın altında sınavda adaylara sorulan sorular var.Her adaya 2 soru soruluyor ve adayın tekil sayfası oluştuğunda öğrenim durumuna göre uygun alanların da (açılır pencere olarak) gelmesi gerekiyor.Gönderdiğiniz toplu makro sonucu oluşan personel dosyasında açılış sırasında " hatalar var ve onarıldı " olarak geliyor.
ve soruların açılır alanları gelmiyor.
 
Sayın Ömer ;
dün çalıştırdığımda dikkat etmemiştim ; bugün kontroller sırasında atladığım bir konu olduğunu farkettim,E9 hücresindeki Eğitim durumuna göre a12'de açılır menü yapmıştım ve E9 hücresine = ile bağlamıştım.E9 hücresi her değiştiğinde a12 deki seçenek de değişiyor.A12 deki açılır pencere de aynı çalışma kitabının Sayfa4 kısmında a1den başlayarak V1 e kadar öğrenim durumları var;a2den başlayarak v13 'e kadar da her başlığın altında sınavda adaylara sorulan sorular var.Her adaya 2 soru (B13-B15 - Açılır pencerede sorular geliyor)soruluyor ve adayın tekil sayfası oluştuğunda öğrenim durumuna göre uygun alanların da (açılır pencere olarak) gelmesi gerekiyor.Gönderdiğiniz toplu makro sonucu oluşan personel dosyasında açılış sırasında " hatalar var ve onarıldı " olarak geliyor.
ve soruların açılır alanları gelmiyor.

Sayın Ömer; Açılır pencerede getirmek istediklerimi VERİ sayfasına yazıp buradan düzenleme yapıp makronuzu çalıştırdığımda sorun çözüme kavuştu.Bazen çözüm çok basit hatta gözümüzün önünde ama ona ulaşmak zaman alıyor.:)
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst