Çözüldü Çalışma sayfasını txt olarak kaydetme makrosu

[cavanoos]

Merhaba arkadaşlar;

10 sayfadan oluşan excel çalışmasındaki bir sayfayı txt olarak kaydetmek istiyorum.
Bunun için gerekli kod konusunda yardımcı olabilir misiniz ?

 

[zozotr]

Sub TxtYAP()
    Dim myFile As String
    Dim rng As Range
    Dim cellValue As String
    Dim i As Integer, j As Integer
    
    myFile = Application.GetSaveAsFilename(FileFilter:="Metin Dosyası (*.txt), *.txt")
    
    If myFile = "False" Then Exit Sub
    
    Open myFile For Output As #1
    
    Set rng = ActiveSheet.UsedRange
    For i = 1 To rng.Rows.Count
        For j = 1 To rng.Columns.Count
            cellValue = rng.Cells(i, j).Value
            
            If cellValue = "" Then
                cellValue = " "
            End If
            
            Print #1, cellValue;
            
            If j <> rng.Columns.Count Then
                Print #1, vbTab;
            End If
        Next j
        Print #1,
    Next i
    
    Close #1
    
    MsgBox "SAYFANIZ METİN DOSYASI ( TXT ) OLARAK KAYDEDİLDİ, KOLAY GELSİN.", vbInformation
    
End Sub

Bu kodu Modül olarak ekleyin. Çalıştığı anda size kaydetmek istediğiniz dosya ismini soracak.
Kolay Gelsin

 

[cavanoos]

Teşekkür ederim, oldu.

Size iki sorum olacak.

1 - Dosya adını KURUMLAR olarak kod içine ekleyebilir miyiz ?
2 - Excel sayfasında A sütunu boş ve B sütunu ise dolu. Manuel olarak sayfayı kopyalayıp yapıştırdığımda A ve B gelir. Kod ile yaptığımda sadece B sütunu var. Nedeni nedir ?

 

[zozotr]

Sub TxtYAP()
    Dim myFile As String
    Dim rng As Range
    Dim cellValue As String
    Dim i As Integer, j As Integer
   
  
    Dim desktopPath As String
    desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
   
  
    myFile = desktopPath & "\" & Application.InputBox("Dosya adını girin:", "Dosya Adı", "Kurumlar") & ".txt"
   
    If myFile = "False" Then Exit Sub
   
    Open myFile For Output As #1
   
    Set rng = ActiveSheet.UsedRange
    For i = 1 To rng.Rows.Count
        For j = 1 To rng.Columns.Count
            cellValue = rng.Cells(i, j).Value
           
            If cellValue = "" Then
                cellValue = " "
            End If
           
            Print #1, cellValue;
           
            If j <> rng.Columns.Count Then
                Print #1, vbTab;
            End If
        Next j
        Print #1,
    Next i
   
    Close #1
   
    MsgBox "SAYFANIZ KURUMLAR OLARAK MASAÜSTÜNE KAYDEDİLDİ, KOLAY GELSİN.", vbInformation
   
End Sub

Kodu Bu şekilde güncelleyin. Direk olarak masaüstüne Kurumlar şeklinde kaydediliyor. Hangi sütunda veri olduğu önemli değil. Her sütundaki verileri TXT dosyasının içinde görebilirsiniz.
Kolay Gelsin

 

[cavanoos]

Ekrana gelen mesaj kutusunda KURUMLAR yazar. Ben tamam deyince kaydeder.
Mesaj kutusuna gerek yok, direkt masaüstüne KURUMLAR olarak kaydedemez mi ?

 

[zozotr]

Sub TxtYAP()
    Dim myFile As String
    Dim rng As Range
    Dim cellValue As String
    Dim i As Integer, j As Integer

    Dim desktopPath As String
    desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")

    myFile = desktopPath & "\Kurumlar.txt"

    Open myFile For Output As #1

    Set rng = ActiveSheet.UsedRange
    For i = 1 To rng.Rows.Count
        For j = 1 To rng.Columns.Count
            cellValue = rng.Cells(i, j).Value

            If cellValue = "" Then
                cellValue = " "
            End If

            Print #1, cellValue;

            If j <> rng.Columns.Count Then
                Print #1, vbTab;
            End If
        Next j
        Print #1,
    Next i

    Close #1

    MsgBox "SAYFANIZ KURUMLAR OLARAK MASAÜSTÜNE KAYDEDİLDİ, KOLAY GELSİN.", vbInformation

End Sub

Bu şekilde kodu güncelleyin. Size sormadan masaüstüne Kurumlar.txt olarak kaydeder.

 

[cavanoos]

Teşekkür ederim.

 

[zozotr]

Rİca Ederim. Kolay Gelsin