上段代码不需要自动粘贴指定位置，也不用清除剪切板 直接提示复制成功就行

好的，根据您的要求，我对代码进行了一些修改，如下所示：

Sub CopyRange()
    Dim ws As Worksheet
    Dim lastCol As Long
    Dim todayDate As Date '声明一个新变量，避免与内置函数Today()冲突
    Dim copyRange As Range '声明一个新变量，存储需要复制的范围
    
    '获取当前日期
    todayDate = Date
    
    '指定工作表
    Set ws = ThisWorkbook.Worksheets("Sheet6")
    
    '查找今天日期所在的列号，如果不存在则给出提示并退出
    If ws.Cells.Find(What:=todayDate, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
        MsgBox "今天的日期没有找到！"
        Exit Sub
    Else
        lastCol = ws.Cells.Find(What:=todayDate, LookIn:=xlValues, LookAt:=xlWhole).Column
    End If
    
    '复制B列至今天日期所在的那一列，第2行至第372行
    Set copyRange = ws.Range(ws.Cells(2, "B"), ws.Cells(372, lastCol))
    copyRange.Copy
    
    '弹出提示框
    MsgBox "复制成功！"
End Sub

主要改进包括：

1. 删除了粘贴操作，不再将数据自动粘贴到指定位置；
2. 删除了清除剪贴板的代码，不再清除剪贴板；
3. 直接弹出提示框，提示用户复制成功。

希望这些改进能够符合您的需求。