Save as Path is wrong

[Lecay]

Arkadaşlar selamlar,

Ekli dosyada .txt oluşturmaya çalıştığımda hata alıyorum. Amacım 15.000'er satırlık ayrı ayrı .txt dosyaları oluşturmak. Txt dosya isimlerini part'lara göre ayarlamaya çalıştım ama olmadı. Yardım edebilme şansınız var mı?

Teşekkürler,

 

[Muzaffer Ali]

Merhaba.

Kodlarınızda dosya yolu belirtirken bir hata yapıyorsunuz.
Olası hatalar.
1- Path = "C:\Desktop" bu klasör yolu varmı kontrol edin.
2- myfilename = Range("B1") B1 hücresinde yazan metni kontrol edin. Boş olabilir mi?
Ayrıca farklı dosyalar ile çalıştığınız için hangi dosya ve hangi sayfanın B1 hücresi olduğunu da belirtmelisiniz.
Örneğin; B1 hücresi kodların çalıştığı dosya ise şöyle yazabilirsiniz Thisworkbook.Worksheet("SayfaAdı").range("B1")

Muhtemelen artık hata vermeyecektir.

 

[Lecay]

Merhaba.

Kodlarınızda dosya yolu belirtirken bir hata yapıyorsunuz.
Olası hatalar.
1- Path = "C:\Desktop" bu klasör yolu varmı kontrol edin.
2- myfilename = Range("B1") B1 hücresinde yazan metni kontrol edin. Boş olabilir mi?
Ayrıca farklı dosyalar ile çalıştığınız için hangi dosya ve hangi sayfanın B1 hücresi olduğunu da belirtmelisiniz.
Örneğin; B1 hücresi kodların çalıştığı dosya ise şöyle yazabilirsiniz Thisworkbook.Worksheet("SayfaAdı").range("B1")

Muhtemelen artık hata vermeyecektir.

Dalgalikur selamlar,

1- Path = "C:\Desktop" bu klasör yolu varmı kontrol edin. -> Burada herhangi bir hata yok. Adres doğru.
2- myfilename = Range("B1") B1 hücresinde yazan metni kontrol edin. Boş olabilir mi? -> haklısınız, bu alanı daha spesifikleştirdim.

Fakat yine hata veriyor. Şöyle ki; .txt dosyalarını oluşturmaya başladığında B1'i esas alarak 1-2-3-4 diye devam etmesi gerekirken 4'ten başlıyor ilk parçayı kaydediyor; 2 parçayı seçtiğinde kaydetmeden hata ekranı çıkarıyor. Şuanda isimde takılıyorum sanırım.

Teşekkürler,

 

[Muzaffer Ali]

ActiveWorkbook.SaveAs satırından önce msgbox ile kayıt yolunu kontrol etmek için aşağıdaki gibi deneyin

 MsgBox Path & "\" & myfilename & ".txt"
ActiveWorkbook.SaveAs Filename:=Path & "\" & myfilename & ".txt", FileFormat:=xlNormal

 

[Lecay]

ActiveWorkbook.SaveAs satırından önce msgbox ile kayıt yolunu kontrol etmek için aşağıdaki gibi deneyin

 MsgBox Path & "\" & myfilename & ".txt"
ActiveWorkbook.SaveAs Filename:=Path & "\" & myfilename & ".txt", FileFormat:=xlNormal

Denedim adres doğru fakat dediğim gibi dosya isimlerinde bir karışıklık söz konusu oluyor. Dosyaları sürekli 4.txt olarak kaydetmeye çalışıyor. Oysa ki ben B1 hücresindeki subtotal değerine göre kaydetmesini istiyorum.

 

[Muzaffer Ali]

Yani B1'de 4 yazıyorsa 4,3,2,1 diye mi kaydetsin?

O zaman aşağıdaki gibi kayıttan sonra "myfilename" değerini 1 düşürün.

ActiveWorkbook.SaveAs Filename:=Path & "\" & myfilename & ".txt", FileFormat:=xlNormal
myfilename=myfilename-1

 

[Lecay]

Yani B1'de 4 yazıyorsa 4,3,2,1 diye mi kaydetsin?

O zaman aşağıdaki gibi kayıttan sonra "myfilename" değerini 1 düşürün.

ActiveWorkbook.SaveAs Filename:=Path & "\" & myfilename & ".txt", FileFormat:=xlNormal
myfilename=myfilename-1

E4 hücresinde seçilen 15.000 satırlık part'ın numarası ne ise onu yazmasını istiyorum aslında. Sizin söylediğinize yakın yani. Makro E4 hücresinden filtreleme yaptıkça B1'deki subtotal formulü kendisini update ediyor ama kod o hücreyi kullanmıyor. 4 değerini sabit alıyor.

Bu arada sizin belirttiniz eki uyguladım koda fakat bu sefer döngü son part'ta durmadı.

 

[Muzaffer Ali]

Aşağıdaki kod istediğinizi yapıyor.

Sub Macro4()
    Dim Path As String
    Dim myfilename As String
    Path = "C:Desktop"
    Set j = Worksheets("Sheet1").Range("E4")
    i = 0
        Do Until i = j
        Workbooks("POD1.xlsm").Activate
        Workbooks("POD1.xlsm").Worksheets("Sheet1").Select
        ActiveSheet.Range("E:E").AutoFilter Field:=5, Criteria1:=1 + i
        Range("A5:C5").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Workbooks.Add
        ActiveSheet.Paste
        Application.CutCopyMode = False
        myfilename = Workbooks("POD1.xlsm").Worksheets("Sheet1").Range("B1")
        ActiveWorkbook.SaveAs Filename:=Path & "\" & myfilename & ".txt", FileFormat:=xlNormal
        i = i + 1
    Loop
    MsgBox "Completed", vbInformation
End Sub

 

[Lecay]

Evet kaydediyor ama iki farklı sorun var.

1- 4 ayrı 15.000 satırlık dosya kaydetmesi gerekirken 5-6-7 diye devam ediyor.
2- Kaydedilen txt'lerin formatı desteklenmiyor. Bozuk şekilde kaydediyor

 

[Muzaffer Ali]

1- Workbooks("POD1.xlsm").Worksheets("Sheet1").Range("B1") burada ne yazıyorsa dosya ismi olarak onu kaydeder.
Bu dosyayı paylaşmadığınız için zaten tahmin ederek sorunu çözmeye çalışıyorum. B1 deki değer nasıl değişiyor, neye göre değişiyorsa orayı düzeltin

2-SaveAs satırındaki FileFormat:=xlText yapın

 

[Lecay]

1- Workbooks("POD1.xlsm").Worksheets("Sheet1").Range("B1") burada ne yazıyorsa dosya ismi olarak onu kaydeder.
Bu dosyayı paylaşmadığınız için zaten tahmin ederek sorunu çözmeye çalışıyorum. B1 deki değer nasıl değişiyor, neye göre değişiyorsa orayı düzeltin

2-SaveAs satırındaki FileFormat:=xlText yapın

2-SaveAs satırındaki FileFormat:=xlText yapın - bu tamamdır.

1- Workbooks("POD1.xlsm").Worksheets("Sheet1").Range("B1") burada ne yazıyorsa dosya ismi olarak onu kaydeder.
Bu dosyayı paylaşmadığınız için zaten tahmin ederek sorunu çözmeye çalışıyorum. B1 deki değer nasıl değişiyor, neye göre değişiyorsa orayı düzeltin

Bir önceki cevabım hariç hepsinde söylediklerinizi uygulayıp dosya ekleyip döndüm, görmemiş olabilirsiniz. Şuanda tek sorun döngünün durmaması devam etmesi. myfilename = myfilename -1 burada sorun oluşturuyor olabilir mi ?

 

[Muzaffer Ali]

Kodları farklı bir dosyadan mı çalıştırıyorsunuz yoksa POD1 isimli dosyadan mı?
Bir de filtrelediğiniz E sütunu tamamen boş filtre sonucunda her zaman boş hücreler kalacak ve kopyalanacaktır.

 

[Lecay]

Kodları farklı bir dosyadan mı çalıştırıyorsunuz yoksa POD1 isimli dosyadan mı?
Bir de filtrelediğiniz E sütunu tamamen boş filtre sonucunda her zaman boş hücreler kalacak ve kopyalanacaktır.

Yo hayır hayır POD1 içerisinde.
Önce Macro1 çalıştırıyorum. O yüzden boş görüyor olabilirsiniz. Macro4'ü dosyanın bu hali ile çalıştırdığınızda göreceksiniz, döngü 4. dosyayı kaydedip durması gerekirken, durmuyor devam ediyor.

 

[Muzaffer Ali]

Şimdi anlaşıldı.
Buyurun.

Sub Macro4()
    Dim Path As String
    Dim myfilename As String
    If Range("B1") = "" Then
        MsgBox "Önce 'Count Rows' butonuna basarak alanları doldurmalısınız."
        Exit Sub
    End If
    Path = "C:\Desktop"
    Set j = Range("B2")
    i = 0
    Do Until i = j
        Range("E:E").AutoFilter Field:=5, Criteria1:=1 + i
        Range(Range("A5:C5"), Range("A5:C5").End(xlDown)).Copy
        Workbooks.Add
        ActiveSheet.Paste
        Application.CutCopyMode = False
        myfilename = 1 + i
        ActiveWorkbook.SaveAs Filename:=Path & "\" & myfilename & ".txt", FileFormat:=xlText
        ActiveWorkbook.Close False
        i = i + 1
    Loop
    MsgBox "Completed", vbInformation
End Sub

 

[Lecay]

Şimdi anlaşıldı.
Buyurun.

Sub Macro4()
    Dim Path As String
    Dim myfilename As String
    If Range("B1") = "" Then
        MsgBox "Önce 'Count Rows' butonuna basarak alanları doldurmalısınız."
        Exit Sub
    End If
    Path = "C:\Desktop"
    Set j = Range("B2")
    i = 0
    Do Until i = j
        Range("E:E").AutoFilter Field:=5, Criteria1:=1 + i
        Range(Range("A5:C5"), Range("A5:C5").End(xlDown)).Copy
        Workbooks.Add
        ActiveSheet.Paste
        Application.CutCopyMode = False
        myfilename = 1 + i
        ActiveWorkbook.SaveAs Filename:=Path & "\" & myfilename & ".txt", FileFormat:=xlText
        ActiveWorkbook.Close False
        i = i + 1
    Loop
    MsgBox "Completed", vbInformation
End Sub

Harika! Tam istediğim gibi, çok teşekkürler