Export multiple cell ranges to different txt files

[steven77]

Hello,

I hope somebody can help me with my question. I have looked at several other posts, but all seem only to help me with some parts of my question. Unfortunately I am not able to incorporate the answer myself.

My problem is as follows.

I have an excel document with multiple pages from which i want to export several cells on different pages to multipe *.txt files.

Page 2 need to export cells C2:C23 to a text file named similar to page2 & ".js".
Page 3 need to export cells C2:C23 to a text file named similar to page3 & ".js".
etc.

Page 1 has the following information:
A2: the pathway for the files to be placed in
A5: text field similar to the name of "page2" for generating the text file name
A6: text field similar to the name of "page3" for generating the text file name

A button to launch the script, which should create the different text files and store them in the correct folder.

Also and additional feature which is not in the script below. Some cells might be empty. If this is the case no text should be placed in the text file. Cell C2 and C23 are alway filled.


So far I have this script, which works if I only have 1 sheet, not with multiple sheets:

Sub JsSave()
ExportToTextFile FName:=Blad1.[A2] & Blad1.[A5] & ".js", Sep:=";", _
SelectionOnly:=True, AppendData:=False
Blad11.[A2].Select
End Sub


Public Sub ExportToTextFile(FName As String, _
Sep As String, SelectionOnly As Boolean, _
AppendData As Boolean)


Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String




Application.ScreenUpdating = False
On Error GoTo EndMacro:
FNum = FreeFile


If SelectionOnly = True Then
With [C2:C23]
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
Else
With ActiveSheet.UsedRange
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
End If


If AppendData = True Then
Open FName For Append Access Write As #FNum
Else
Open FName For Output Access Write As #FNum
End If


For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = Chr(34) & Chr(34)
Else
CellValue = Cells(RowNdx, ColNdx).Text
End If
WholeLine = WholeLine & CellValue & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine
Next RowNdx


EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #FNum


End Sub