VBA ile İlgili Kısa Bir Soru

[Bülent Öztürk]

DOSYA ADI KISMINI DEĞİŞTİRDİM "C:\Users\XXXX\Desktop\me" CSV LERİN İÇİNDE OLDUĞU KLASÖRÜN ADINI YAPIYORUM AMA ORDA HATA VERİYOR CSVLER ME KLASÖRÜNDE

Tamamen büyük harfle yazmayalım lütfen.

"C:\Users\XXXX\Desktop\me" yi "C:\Users\XXXX\Desktop\me\" şeklinde yapar mısınız?

While dosyaadi <> ""

  Bu da bir döngüdür. Dosya bulamayana kadar devam eder.

Döngü çeşitlerini internetten araştırabilirsiniz.

Örnekler: http://excelvba.net/viewtopic.php?f=63&t=625

[mermer]

üstat şöyle bir uayrı alıyorum nerde hata yapıyrum ki

[mermer]

ÜSTAT kodun çalışan son şekli elimden bu kadar geldi bir exel sayfasında bul değiştirle ARCLK isimlerini  vestl bosh vs yapıp alt altalta copy paste yapacam kodları başka çarem kalmadı 367 tane csv var biarz uğraştıracak ama olsun başka çarem kalmadı

[mermer]

Sub TT()
ThisWorkbook.Sheets.Add.Name = "ARCLK"
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("ARCLK")
Application.Workbooks.Open ("C:\Users\xxxxx\Desktop\me\ARCLK.csv")
Sheets("ARCLK").Range("A1").CurrentRegion.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, Semicolon:=True
Sheets("ARCLK").Rows("2:2").Insert Shift:=xlDown
Sheets("ARCLK").Rows("3:3").Insert Shift:=xlDown
Sheets("ARCLK").Cells(2, 1) = "Hisse Adı"
Sheets("ARCLK").Cells(3, 1) = "Para Birimi"
Sheets("ARCLK").Range("B2:AW2") = "ARCLK"
Sheets("ARCLK").Range("B3:AW3") = "TL"
Sheets("ARCLK").Range("A1").CurrentRegion.Copy
sh.Range("A1").PasteSpecial xlPasteValues, Transpose:=True
Workbooks("ARCLK.csv").Save
Workbooks("ARCLK.csv").Close
End Sub

[mermer]

Kodu biraz daha geliştirirsek:

Kod: [Seç]

   Dim dosyaadi As String
    dosyaadi = Dir("C:\Excelce\")
    While dosyaadi <> ""  'Klasör içinde dosya ara
        Application.Workbooks.Open "C:\Excelce\" & dosyaadi  ' Sırayla dosyaları aç
        ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = dosyaadi 'Açılan dosya adında sayfa ekle
        dosyaadi = Dir
       
    Wend
üstat sayende hallettim yaptığım hata \ iki tane doysa yolunun 1. sine \ imleci koymak ikincisine koymamakmış Çok sağol Allah ne muradın  varsa versin aklıma geldikçe hep duacınım beni büyük bir yüketn kurtardın

Yukarıdaki şekilde, klasördeki dosyaları sırayla açıyor ve mevcut dosyamızda o isimde bir sayfa ekliyoruz.


Aşağıdaki koda ise sizin kodların entegre edilmesi örneğini görebilirsiniz:

Kod: [Seç]

   Dim dosyaadi As String
   
    dosyaadi = Dir("C:\Excelce\")
    While dosyaadi <> ""  'Klasör içinde dosya ara
        Application.Workbooks.Open "C:\Excelce\" & dosyaadi  ' Sırayla dosyaları aç
       
        'Sizin yaptırdığınız işlemler:
        ActiveSheet.Range("A1").CurrentRegion.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, Semicolon:=True
        ActiveSheet.Rows("2:2").Insert Shift:=xlDown
        ActiveSheet.Rows("3:3").Insert Shift:=xlDown
        ActiveSheet.Cells(2, 1) = "ÜRÜN ADI"
        ActiveSheet.Range("B2:AW2") = "ARCLK"
        ActiveSheet.Range("A1").CurrentRegion.Copy
               
        ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = dosyaadi 'Açılan dosya adında sayfa ekle
        ThisWorkbook.Sheets(dosyaadi).Range("A1").PasteSpecial xlPasteValues, Transpose:=True
       
        Workbooks(dosyaadi).Close , False 'açtığımız dosyayı kaydetmeden kapatıyoruz
        dosyaadi = Dir
       
    Wend
Bu arada, daha sağlıklı kontrol için örnek csv'lerden bir tane ekleyebilir misiniz?

[mermer]

üstat sayende hallettim yaptığım hata \ iki tane doysa yolunun 1. sine \ imleci koymak ikincisine koymamakmış Çok sağol Allah ne muradın  varsa versin aklıma geldikçe hep duacınım beni büyük bir yüketn kurtardın

[Bülent Öztürk]

Yardımcı olabildiğime sevindim.
Çalışmalarınızda başarılar.