サンプルコード


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