hücredeki metin ismi ile yeni bir excel dosyası oluşturma makrosu

[conqueror34]

merhaba arkadaşlar.

ben müşteriler.xls adlı bir excel dosyası içerisindeki müşteri listesinde bulunan her bir müşterinin isminin yazılı olduğu hücrelerde bir makro çalıştırarak o isim ile yeni bir boş excel dosyası oluşturmasını istiyorum. (yeni oluşturacağı dosya da müşteri listesi ile aynı klasör içerisinde olacak şekilde.. )

- bu işlemi tüm listeyi seçip tek bir seferde yapmak istemiyorum. her seferinde müşteri listesine ara ara yeni müşteriler ekledikçe her bir yeni müşteri ismine tıklayıp makroyu çalıştırıp o isimle yeni bir dosya oluşturacağım.-

Bu makroyu nasıl yapabilirim, denedim ama yapamadım hata veriyor. yardımcı olabilirmisiniz?

teşekkürler..

 

[Asri]

Müşterilerin bulunduğu sayfanın kod bölümüne yapıştırınız.
Müşteri isimleri A kolonunda var sayılmıştır. Değiştirmek içi A1:A10000 i değiştiriniz.

Her müşteri ismini çift tıkladığınızda aynı klasörde müşteri ismi ile dosyalar oluşacaktır.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim aktifkitap As Workbook
    If Intersect(Target, Range("A1:A10000")) Is Nothing Then Exit Sub
    musteriadi = Target.Value
    Set aktifkitap = ActiveWorkbook
    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:=aktifkitap.Path & "\" & musteriadi & ".xlsx"
    ActiveWorkbook.Close savechanges:=False
End Sub

 

[conqueror34]

vakit ayırıp yazdığınız cevap için teşekkür ederim. şimdi deneyeceğim. saygılar..

 

[conqueror34]

Müşterilerin bulunduğu sayfanın kod bölümüne yapıştırınız.
Müşteri isimleri A kolonunda var sayılmıştır. Değiştirmek içi A1:A10000 i değiştiriniz.

Her müşteri ismini çift tıkladığınızda aynı klasörde müşteri ismi ile dosyalar oluşacaktır.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim aktifkitap As Workbook
    If Intersect(Target, Range("A1:A10000")) Is Nothing Then Exit Sub
    musteriadi = Target.Value
    Set aktifkitap = ActiveWorkbook
    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:=aktifkitap.Path & "\" & musteriadi & ".xlsx"
    ActiveWorkbook.Close savechanges:=False
End Sub

kod çalıştı ve işimi görüyor tekrar teşekkür ederim. birde unuttuğum birşey olmuş şimdi farkettim; bu müşteri listesindeki her bir satıra aynı anda oluşturduğumuz dosyalar için linkte eklememiz mümkün mü acaba?

 

[alicimri]

En alt satıra End Sub dan önce aşağıdaki satırı ekleyin.

  ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=musteriadi & ".xlsx"

 

[conqueror34]

En alt satıra End Sub dan önce aşağıdaki satırı ekleyin.

  ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=musteriadi & ".xlsx"

hocam yardımlarınız için teşekkürler. kodları kullanarak dosyayı oluşturdum. umarım aynı konuda bilgi arayan farklı kişilere de faydası dokunur. sağolun. saygılar..

 

[berkayDmn]

Müşterilerin bulunduğu sayfanın kod bölümüne yapıştırınız.
Müşteri isimleri A kolonunda var sayılmıştır. Değiştirmek içi A1:A10000 i değiştiriniz.

Her müşteri ismini çift tıkladığınızda aynı klasörde müşteri ismi ile dosyalar oluşacaktır.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim aktifkitap As Workbook
    If Intersect(Target, Range("A1:A10000")) Is Nothing Then Exit Sub
    musteriadi = Target.Value
    Set aktifkitap = ActiveWorkbook
    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:=aktifkitap.Path & "\" & musteriadi & ".xlsx"
    ActiveWorkbook.Close savechanges:=False
End Sub

Merhaba;
Bu işlemi var olan bir excel dosyasını kopyalayıp, adını gireceğim bilgilere göre değiştirip kayıt eden bir kodu mevcutmudur ?

Çok zahmetli bir iş biliyorum ama çıkamadım işin içinden