将单列区域导出到文本文件

Sub ExportColumnsA()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim pSep As String: pSep = Application.PathSeparator
    Dim TextFile As Long: TextFile = FreeFile
    
    Dim ws As Worksheet, rg As Range, fCell As Range, lCell As Range
    Dim Data(), rCount As Long, r As Long, rString As String, fPath As String
    
    For Each ws In wb.Worksheets
        Set fCell = ws.Range("A3")
        Set lCell = fCell.Resize(ws.Rows.Count - fCell.Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If Not lCell Is Nothing Then ' data in column
            ' Reference the range.
            Set rg = ws.Range(fCell, lCell)
            ' Write the values from the range to an array.
            rCount = rg.Rows.Count
            If rCount = 1 Then
                ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
            Else
                Data = rg.Value
            End If
            ' Write the values from the array to a string.
            rString = CStr(Data(1, 1))
            For r = 2 To rCount
                rString = rString & vbLf & CStr(Data(r, 1))
            Next r
            ' Write the string to the text file.
            fPath = wb.Path & pSep & ws.Name & ".txt"
            Open fPath For Output As #TextFile
                Print #TextFile, rString;
            Close #TextFile
        'Else ' no data in column; do nothing
        End If
    Next ws
    
    MsgBox "Columns ""A"" exported.", vbInformation

End Sub