yeni çalışma kitabı oluştur ( listedeki isimlere göre)

[talip55]

sayfa 1 deki listeye göre yeni çalışma kitapları kaydetmek istiyorum..

 

[Zeki Gürsoy]

Sayfa1'de B1 hücresine dosyaların kaydedileceği yolu yazın ve "test" isimli proseduru çalıştırın.

Sub test()

With ThisWorkbook

    For i = 1 To .Sheets("Sayfa1").[a65000].End(3).Row
        Call Copy_To_New(.Sheets("şablonsayfa"), _
            .Sheets("sayfa1").[b1], _
                .Sheets("sayfa1").Cells(i, 1).Value)
    Next
    
End With

End Sub

Private Sub Copy_To_New(sh As Worksheet, _
                        dst As String, _
                        fname As String)
Dim wb As Workbook

If Dir(dst & fname & ".xls") <> "" Then _
    MsgBox "'" & dst & fname & ".xls'" & _
        " mevcuttur!!!": Exit Sub
        
Set wb = Workbooks.Add

ThisWorkbook.Sheets("" & sh.Name).Copy before:=wb.Sheets(1)

Application.DisplayAlerts = False
For i = wb.Sheets.Count To 2 Step -1
    wb.Sheets(i).Delete
Next
Application.DisplayAlerts = True

wb.Sheets(1).Name = sh.Name
dst = IIf(Right$(dst, 1) = "\", dst, dst & "\")
wb.SaveAs dst & fname & ".xls"
wb.Close False

Set wb = Nothing
End Sub

 

[talip55]

yeni çalışma kitepları kaydetmek

Sayın Zeki Bey çok sağolasın işime çok kolaylaştırdı.eline zihnine sağlık.
Burada şablon sayfaya ilave olarak birsayfa daha ilave edilebilirmi. Mesela şablonsayfa ve sayfa 3'ü de kopyalamak için ne yapmak lazım. Teşekkürler...

 

[Zeki Gürsoy]

Sayfa3 boş görünüyordu. Boş sayfa olarak mı kopyalanacak?

 

[talip55]

yeni çalışma kitabı oluştur

evet zeki bey sayfa 3 de vardı aslında ben ilave etmemiştim.