Liste kadar excel dosyası açma

[akmes]

Merhaba, hayırlı cumalar, hayırlı işler herkese, Masaüstünde Dekont Klasör altında Dekont Şablonu diye bir excel dosyam var bu dosyadan 1 den 30 kadar yeni dosya elde etmek istiyorum. Bunu için aynı klasör altında isim ekleme diye bir dosya açtım .Sayfa 1 de A1:A30 arasında 1 den 30 a kadar rakamlar var. Burada yazılanlar kadar klasör altındaki Dekont Şablonu dosyamdan 30 tane dosya kopyalayıp oluşturabilir miyiz. Yardımlarınızı rica ediyorum

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Sablon_Dosyasini_Kopyala()
    Dim Yol As String, Dosya As String, Veri As Range
    
    Yol = ThisWorkbook.Path & "\"
    Dosya = Yol & "Dekont Şablonu.xlsx"
    
    With Sheets("Sayfa1")
    
    For Each Veri In .Range("A1:A" & .Cells(.Rows.Count, 1).End(3).Row)
        FileCopy Dosya, Yol & Veri.Value & "." & _
        VBA.CreateObject("Scripting.FileSystemObject").GetExtensionName(Dosya)
    Next
    
    End With
    
    MsgBox "Şablon dosyaları oluşturulmuştur."
End Sub

 

[akmes]

Deneyiniz.

Option Explicit

Sub Sablon_Dosyasini_Kopyala()
    Dim Yol As String, Dosya As String, Veri As Range
   
    Yol = ThisWorkbook.Path & "\"
    Dosya = Yol & "Dekont Şablonu.xlsx"
   
    With Sheets("Sayfa1")
   
    For Each Veri In .Range("A1:A" & .Cells(.Rows.Count, 1).End(3).Row)
        FileCopy Dosya, Yol & Veri.Value & "." & _
        VBA.CreateObject("Scripting.FileSystemObject").GetExtensionName(Dosya)
    Next
   
    End With
   
    MsgBox "Şablon dosyaları oluşturulmuştur."
End Sub

Korhan Bey, çok teşekkür ederim. Tam istediğim gibi olmuş. Sizin nezdiniz de tüm excel web tr emeği geçen herkesin yeni yılını kutlarım. Sağlık ve mutluluk dolu bir yıl olmasını dilerim.