您好，以下是您要的代码，我以加入注释，详细请看Excel，回答完毕，祝您好运。
Dim MyTxt As String '用来存储结果字符串
Private Sub CommandButton1_Click()
Dim I As Integer
Dim maxNum As Integer
maxNum = ActiveSheet。
  UsedRange。Rows(ActiveSheet。UsedRange。Rows。Count)。Row - 1 '序号
MyTxt = "序号|卡号|姓名|金额" & Chr(13)
For I = 2 To maxNum
    Dim titleNo As String '序号
    Dim cardNo As String '卡号
    Dim Name As String  '姓名
    Dim Money As String '金额
    Sheets("Sheet1")。
  Range("A" & I)。Select
    titleNo = Trim(ActiveCell。Text) + "|"
    Sheets("Sheet1")。Range("B" & I)。Select
    cardNo = Trim(ActiveCell。
  Text) + "|"
    Sheets("Sheet1")。Range("C" & I)。Select
    Name = Trim(ActiveCell。Text) + "|"
    Sheets("Sheet1")。Range("D" & I)。
  Select
    Money = Trim(ActiveCell。Text) & Chr(13)
    MyTxt = MyTxt + titleNo + cardNo + Name + Money '最终组成的字符串
Next I
Call OutPut
End Sub
Sub OutPut()
CommonDialog1。
  Filename = "" '初始化文件路径+文件名
CommonDialog1。Filter = "ﾎﾄｱｾﾎﾄｼ(*。txt)|*。
  txt" '设置存为文本文档格式
While (True)
    CommonDialog1。ShowSave '保存对话框
    If Dir(CommonDialog1。Filename) <> "" And Trim(CommonDialog1。
  Filename) <> "" Then '判断选择的路径是否已存在且不为空
        MsgBox "文件已存在，请选择一个新的名字" '提示框
    Else
        If Trim(CommonDialog1。Filename) <> "" Then
            Open CommonDialog1。
  Filename For Output As #1 '打开文件
            Print #1, MyTxt '向文件中写入字符串
            Close #1 '关闭文件
            Exit Sub
        Else
            Exit Sub
        End If
    End If
Wend
End Sub
。