Copying Columns to each notepad

[xsdip]

I am very new to excel VBA. I have learned the basics of VBA programing language. Could you please anyone help me in this.

Assuming I have numbers in F9 to F208996 and G9 to G330571 etc.

How do I capture these numbers and convert it into separate nodepad files. i.e. I mean to say, F column datas in one textpad and G column datas in another textpad etc.

In figure below, I need to capture the bold numbers. The columns to be converted to each notepad are F,G,H,I always. The row to be converted to notepad starts always from 9th row till lot of numbers

I have made a rough code. But not sure how to write loop.

Sub Export()
Dim lastrow As Long
Dim lastcolumn As Long
Dim i As Integer, j As Integer

lastrow = Cells(1, "A").End(xlDown).Row
lastcolumn = activesheets.Cells(1, Column.Count).End(xlToLeft).Column

For i = 1 To lastrow
For j = 1 To lastcolumn



Next j
Next i


End Sub

 

[Marc L]

​

Share at least a source workbook and an expected result Notepad text file accordingly …​

 

[xsdip]

This is the source workbook

I would like to get output like this.

Inside Sheet1_Number1.txt

Inside Sheet1_Number2.txt

Similarly for Sheet1_Number3.txt and Sheet1_Number4.txt

 

[xsdip]

Could anyone please help me in this.

 

[Alex Blakenburg]

I can't guarantee this is faster but give it a whirl.
You will need to update where your data starts (cellStart currently set to F9)
and your folder_Name.

Sub ExportToTextFile()

    Dim wbRead As Workbook
    Dim shRead As Worksheet
    Dim wbTemp As Workbook
    Dim shTemp As Worksheet
    Dim cellStart As Range
    Dim lastRow As Long, lastCol As Long, currCol As Long, firstRow As Long
    Dim i As Long
    Dim folder_Name As String
    Dim file_Name As String
   
    Application.ScreenUpdating = False
   
    Set wbRead = ThisWorkbook
    Set shRead = wbRead.ActiveSheet
   
    Set cellStart = shRead.Range("F9")                      '<----- Update starting position
    firstRow = cellStart.Row + 1
    currCol = cellStart.Column
   
    ' Get the last cell with data in row 1
    lastCol = shRead.Cells(cellStart.Row, shRead.Columns.Count).End(xlToLeft).Column
   
    folder_Name = "C:\Users\Documents\Excel\Test\"          '<----- Update Folder
    For i = cellStart.Column To lastCol
        Set wbTemp = Workbooks.Add
        Set shTemp = ActiveSheet
        With shRead
            .Range(.Cells(firstRow, i), .Cells(Rows.Count, i).End(xlUp)).Copy
        End With
        shTemp.Range("A1").PasteSpecial Paste:=xlPasteValues
        file_Name = shRead.Cells(cellStart.Row, i).Value
       
        Application.DisplayAlerts = False
        wbTemp.SaveAs fileName:=folder_Name & file_Name, _
                        FileFormat:=xlTextMSDOS, CreateBackup:=False
        wbTemp.Close SaveChanges:=False
        Application.DisplayAlerts = True
    Next i

    Application.ScreenUpdating = True
End Sub

 

[xsdip]

Thank you so much for the reply.

Could you please help me with below query

How would I browse a path and save the textfile in wherever we are interested instead of the C drive path

 

[Alex Blakenburg]

It's pretty late here in Sydney Australia.
You will find this post has what you need.
Dest is the folder path.

Post in thread 'vba help - Copy all folder and subfolders names from previous month to next month' vba help - Copy all folder and subfolders names from previous month to next month

 

[xsdip]

Tha k you so much @Alex Blakenburg .. the code works pretty good and fast.

Regarding the folder picker option, I gave the code like this . But it does not work fine.

Dim folder_name as Filedialog
Set folder_name= application.filedialog(msofiledialogfolderpicker)
With folder_name
.Allow multiselect=True
.show

Could you please help me in this

 

[Alex Blakenburg]

Regarding the folder picker option, I gave the code like this . But it does not work fine.

Just replace this:

folder_Name = "C:\Users\Documents\Excel\Test\"          '<----- Update Folder

With this:

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Title = "Select Destination folder"
        If .Show = 0 Then Exit Sub
        folder_Name = .SelectedItems(1)
    End With

 

[xsdip]

Thank you for the quick reply. I have used the same.

Actually, the textfiles now saves outside of the folder and not inside.

That is if I select D:\Newfolder, the textfiles is getting generated in D:\