Kapalı dosyaya veri yazma

[igultekin2000]

Merhaba;
001
002 şeklinde excel dosyalarım var. "Dosya" klasörünün içindeki excel çalışma sayfalarımın "J " HÜCRESİNE "A" sütunundaki dolu veriye göre dosyanın ismini yani "001", "002" şeklinde yazdırmak istiyorum. Bununla ilgili makroyu nasıl yapabilirim.
Her dosyanın J hücresine, kendi dosya ismini yazıldığında üzerinde işlem yapabileceğim. Teşekkürler.

 

[igultekin2000]

Merhaba;
Kapalı dosyaların J hücresine dosya isimlerini yazdırmayı yapabildim ama dosya isminin yanında .xls şeklide dosya uzantısını da yazıyor. Bu uzantının yazılmamasının nasıl sağlayabilirim. Makrom şu şeklide;

Sub vergi_borc()
Dim dosya As String
Dim klasor_liste As String
Dim kitap As Workbook

Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Birleştirilecek dosyaların olduğu klasörü seçin"
.ButtonName = "Dosya Seç"

If .Show = 0 Then

Exit Sub

Else
dosya = .SelectedItems(1) & "\"
End If

satir = ThisWorkbook.Sheets(1).Cells(Rows.Count, "a").End(xlUp).Row + 1
sütun = Cells(1, Columns.Count).End(xlToLeft).Column


klasor_liste = Dir(dosya & "*xls*")
Do Until klasor_liste = ""
Set kitap = Workbooks.Open(dosya & klasor_liste)
sonsatir = kitap.Sheets(1).Cells(Rows.Count, "a").End(xlUp).Row
sonsütun = kitap.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
kitap.Sheets(1).Range("J2:J" & sonsatir).Value = kitap.Name
kitap.Save
kitap.Close
klasor_liste = Dir
Loop
End With
Range("A2") = dosya
Application.ScreenUpdating = True

End Sub

 

[dEdE]

Aşağıdaki linki inceler misiniz?

Dosya Adını MsgBox ile Uzantısız Alma

Merhaba, saygılar hocalarımız Örnek dosyada mesaj kutusunda, dosya adını .xlsm kısmı olmadan alabilmemiz mümkün mü? Yani sadece istanbul-izmir yazacak. .xlsm kısmı yazmayacak.

www.excel.web.tr

 

[igultekin2000]

Teşekkür ederim, farklı uygulamalar, umarım yapabilirim.

 

[dEdE]

... umarım yapabilirim.

Aynı linkte #2 numaralı mesajda daha basit bir yöntem var. Kolayca yapabilirsiniz.

 

[igultekin2000]

Teşekkürler, gayet kısa bir kodla çözülmüş oldu. İyi çalışmalar.

 

[igultekin2000]

Sonunda makro çalışmam tamamlandı.
Çalışma dosyasındaki isimlerin kod numarasına ait kapalı dosyalardaki toplamları listeye yazdırabiliyoruz.
tek hata çalışma listesinde isim olup da ona ait kapalı dosya yoksa, o kısma gelince hata veriyor. Onu klasik yöntemle On Error Resume Next ile çözebiliriz. Ancak bunsuz çözmek daha iyi olabilirdi.