Excel 将所选内容从工作表复制到新工作簿,值/数字格式,另存为制表符分隔的.txt到特定位置,关闭新工作簿

Excel 将所选内容从工作表复制到新工作簿,值/数字格式,另存为制表符分隔的.txt到特定位置,关闭新工作簿,excel,vba,Excel,Vba,正如标题所述。我正在尝试自动化这个过程。最终结果是,我将文本文件通过电子邮件发送给静态收件人。如果可以,很好,如果不能,我有另一个宏来处理这个简单的任务 我可以将所需的选择(AM1:CK74)复制到新工作簿中,但其余的则无法复制 因此,我想从命令按钮将AM1:CK74从活动工作表复制到新工作簿,以A1值和数字格式粘贴,另存为制表符分隔的.txt,文件名应为单元格B1和C1的值。然后将此文本文件与Outlook一起发送电子邮件 非常感谢您的帮助。我搞乱了自动录制功能,但这对我来说太具体了

正如标题所述。我正在尝试自动化这个过程。最终结果是,我将文本文件通过电子邮件发送给静态收件人。如果可以,很好,如果不能,我有另一个宏来处理这个简单的任务

我可以将所需的选择(AM1:CK74)复制到新工作簿中,但其余的则无法复制

因此,我想从命令按钮将AM1:CK74从活动工作表复制到新工作簿,以A1值和数字格式粘贴,另存为制表符分隔的.txt,文件名应为单元格B1和C1的值。然后将此文本文件与Outlook一起发送电子邮件

非常感谢您的帮助。我搞乱了自动录制功能,但这对我来说太具体了

    Sub DataPull3()
'
' DataPull3 Macro
'

'
    Range("AL1:CK74").Select
    Application.CutCopyMode = False
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs FileName:="C:\Users\##\Documents\Book10.txt", _
        FileFormat:=xlText, CreateBackup:=False
End Sub
谢谢。

希望这能有所帮助

Sub Macro2()

     Dim OutApp As Object
    Dim OutMail As Object

    Range("AM1:CK74").Copy
    Workbooks.Add
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ChDir "C:\temp"
    ActiveWorkbook.SaveAs Filename:="C:\temp\Book3.txt", FileFormat:=xlText, CreateBackup:=False

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .to = "email.com"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = "Hi there"
  '      .Attachments.Add ActiveWorkbook.FullName
        .Attachments.Add ("C:\temp\Book3.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

通过你的慷慨帮助,我解决了我的问题。请参阅我所做更改的附加代码

谢谢你

Sub CopyDistribute()

     Dim OutApp As Object
    Dim OutMail As Object
    Dim relativePath As String, sname As String

    Application.ScreenUpdating = False

    Range("AM1:CK74").Copy
    Workbooks.Add
     Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False

        Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs FileName:=relativePath & Range("A1") & Range("B1"), _
    FileFormat:=xlText, CreateBackup:=False

    sname = ActiveWorkbook.Worksheets(1).Range("A1") & ".xls"
    relativePath = Application.ActiveWorkbook.path & "\" & sname
        Application.DisplayAlerts = True


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .to = "EMAIL.com"
        .cc = ""
        .BCC = ""
        .Subject = ""
        .Body = ""
        .Attachments.Add ActiveWorkbook.FullName
        .Send
    End With
    ActiveWorkbook.Close False

    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    Application.ScreenUpdating = True

End Sub

发布当前代码。这只是复制值和数字格式。它是通过录音机生成的,只需稍加调整。除此之外,我希望文件名引用工作表中的两个单元格。然后关闭工作簿。我调整了粘贴以粘贴特殊的值和格式,这几乎是完美的。如果文件可以根据B1和C1(日期和位置)的值命名,那么新创建的工作簿将关闭,这将是完美的。谢谢萨提斯!