サンプルコード
Sub ExportWorksheetContents()
Dim filePath As String
Dim fileNum As Integer
Dim row As Integer
Dim col As Integer
Dim cellValue As String
Dim lastRow As Integer
Dim lastCol As Integer
Dim cell As Range
Dim outputText As String
'ファイルパスの指定
filePath = "C:\Users\UserName\Desktop\WorkbookContents.txt"
'テキストファイルを開く
fileNum = FreeFile()
Open filePath For Output As #fileNum
'ワークシートの最終行と最終列を取得
lastRow = ActiveSheet.Cells.Find(What:="*", _
After:=ActiveSheet.Cells(1, 1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
lastCol = ActiveSheet.Cells.Find(What:="*", _
After:=ActiveSheet.Cells(1, 1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
'ワークシートの値が入っているセルを書き出す
For Each cell In ActiveSheet.Range(Cells(1, 1), Cells(lastRow, lastCol))
If Not IsEmpty(cell.Value) Then
outputText = outputText & cell.Value & vbCrLf
End If
Next cell
'テキストファイルにまとめて書き出す
Print #fileNum, outputText
'テキストファイルを閉じる
Close #fileNum
End Sub