Tablodaki verilerin her birinden excel dosyası oluşturma

[hureyre84]

Merhabalar.
Bu konuyu daha önce yazmıştım ama word dosyası oluşturmuştu.
Konu şu;
tablom da
sicil no adı soyadı diye iki sütun var ve 5000 satırda veriler dolu.

Yapmak istediğim buton ekleyip butona bastığımda belirttiğim klasöre excel dosyası oluştursun. Bu dosyanın adı da sicil no sütunundaki sicil no olmalı.
bu işlem bütün sicil no lar için yapılacak.
dosyayı oluştururken her excel dosyası oluşturulurken daha önce yaptığım excel şablonu oluşturulan excel dosyalarının içine yapıştırılması lazım.
Yani oluşturulan her excel dosyasını açtığımda yaptığım şablon olmalı.

Şimdiden teşekkür ederim

 

[Erdem Akdemir]

Merhaba,

Sorunuz çok anlaşılır değil. Örnek dosya ekleyebilir misiniz.
Ayrıca 5000 tane excel dosyayı oluşturmak hiç verimli bir çalışma yöntemi değil.

 

[hureyre84]

Merhaba,

Sorunuz çok anlaşılır değil. Örnek dosya ekleyebilir misiniz.
Ayrıca 5000 tane excel dosyayı oluşturmak hiç verimli bir çalışma yöntemi değil.

O konuda haklısınız ama bu şekilde yapmak zorundayım .Konuyu şöyle açılayayım. Aşağıdaki kodlar word dosyası oluşturmak için. Ben excel için uyarlamaya çalıştım ama yapamadım.

Private Sub CommandButton1_Click()
Dim sonsatir As Long
Dim sicilno As Range
Dim WordBelgesi As Object
Dim dosyayolu As String
Set WordBelgesi = CreateObject("Word.Application")
dosyayolu = ThisWorkbook.Path & "\"
With ActiveSheet
    sonsatir = .Range("A65500").End(xlUp).Row
    For Each sicilno In Range("A2:A" & sonsatir)
        If sicilno.ffset(0, 2).Hyperlinks.Count = 0 Then
            With WordBelgesi
                .Documents.Add
                .Documents(.Documents.Count).SaveAs Filename:=dosyayolu & sicilno.Text & ".docx"
                .Documents(sicilno.Text & ".docx").Close SaveChanges:=wdSaveChanges
            End With
            sicilno.ffset(0, 2).Value = sicilno.Text & "  Word Dosyasını Aç"
            sicilno.ffset(0, 2).Hyperlinks.Add Anchor:=sicilno.ffset(0, 2), Address:=dosyayolu & sicilno.Text & ".docx"
        End If
    Next sicilno
    Range("C2:C" & sonsatir).Columns.AutoFit
End With
End Sub